home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / emulators / evi.el < prev    next >
Encoding:
Text File  |  1995-02-21  |  186.7 KB  |  5,587 lines

  1. ;; Copyright (c) 1992, 1993, 1994 Jeffrey R. Lewis
  2. ;; All rights reserved.
  3. ;;
  4. ;; Redistribution and use in source and compiled forms, with or without
  5. ;; modification, are permitted provided that the following conditions
  6. ;; are met:
  7. ;; 1. Redistributions of source code must retain the above copyright notice,
  8. ;;    this list of conditions and the following disclaimer.
  9. ;; 2. Redistributions in compiled form must either be accompanied by the
  10. ;;    source, or reproduce the above copyright notice, this list of conditions
  11. ;;    and the following disclaimer in the documentation and/or other materials
  12. ;;    provided with the distribution.
  13. ;;
  14. ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  15. ;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  16. ;; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  17.  
  18. ;; LCD Archive Entry:
  19. ;; evi|Jeffrey R. Lewis|jlewis@cse.ogi.edu
  20. ;; |Emulate Vi - enhanced emacs vi emulator for vi-heads
  21. ;; |7-23-94|1.1c|~/modes/evi.tar.Z
  22. (defvar evi-version "Evi 1.1c of 7-23-94")
  23. (defvar evi-copyright "Copyright (c) 1992, 1993, 1994 Jeffrey R. Lewis")
  24.  
  25. ;; Here follows Evi 1.0, an even better vi emulator aimed at those who either
  26. ;; are well accustomed to vi, or who just simply happen to like its style of
  27. ;; editing better than emacs' default.  Evi's first goal is vi compatibility.
  28. ;; Its second goal is to be an extension of vi, taking advantage of features
  29. ;; supplied by the emacs environment, without simply becoming emacs with vi'ish
  30. ;; key bindings.
  31.  
  32. ;; You can get the latest copy of evi or its documentation by sending an
  33. ;; e-mail message to mail-server@brandx.rain.com.  The body of the message
  34. ;; should look like:
  35. ;;      begin
  36. ;;    send <files>
  37. ;;      end
  38. ;; where <files> is a space separated list taken from: evi.el, evi.tex
  39. ;; (documentation in TeX), evi.info (documentation in emacs info format) or
  40. ;; evi.tar.gz (for a tar of all three).  Any file may be requested in either
  41. ;; compressed (.Z) or gzipped (.gz) format by appending the appropriate suffix.
  42. ;; Compressed or gzipped files will be uuencoded.  For example, the following
  43. ;; will fetch evi.el.gz and evi.info.gz:
  44. ;;      begin
  45. ;;    send evi.el.gz evi.info.gz
  46. ;;      end
  47. ;; Alternately, you can pick up a copy of evi from the elisp archive,
  48. ;; archive.cis.ohio-state.edu, in the file
  49. ;;      pub/gnu/emacs/elisp-archive/modes/evi.tar.Z
  50. ;; This copy is, however, not kept as up-to-date.
  51.  
  52. (defmacro evi-defbuffervar (name default-value documentation)
  53.   (list 'progn (list 'defvar name nil documentation)
  54.            (list 'make-variable-buffer-local (list 'quote name))
  55.            (list 'set-default (list 'quote name) default-value)))
  56.  
  57. (defvar evi-inhibit-startup-message nil)
  58.  
  59. (defvar evi-emacs-version
  60.   (cond ((string-match "Epoch 4" (emacs-version))
  61.      'emacs18)
  62.     ((string-match "^18\\." emacs-version)
  63.      'emacs18)
  64.     ((string-match "^19\\..*\\(XEmacs\\)" emacs-version)
  65.      'lucid19)
  66.     ((string-match "^19\\." emacs-version)
  67.      'emacs19)))
  68.  
  69. (cond
  70.   ((eq evi-emacs-version 'emacs18)
  71.     (defun evi-fill-keymap (keymap def)
  72.       (fillarray keymap def))
  73.  
  74.     (defun evi-keymap-bindings (map)
  75.       (evi-keymap-bindings2 map ""))
  76.  
  77.     (defun evi-keymap-bindings2 (map prefix)
  78.       (if (arrayp map)
  79.       (let ((i 0)
  80.         (len (length map))
  81.         (binding)
  82.         (keys)
  83.         (mappings nil))
  84.         (while (< i len)
  85.           (setq binding (aref map i))
  86.           (if binding
  87.           (progn
  88.             (setq keys (concat prefix (char-to-string i)))
  89.             (if (keymapp binding)
  90.             (setq mappings
  91.                   (nconc (evi-keymap-bindings2 binding keys)
  92.                      mappings))
  93.               (setq mappings (cons (cons keys binding) mappings)))))
  94.           (setq i (1+ i)))
  95.         mappings)
  96.     (let ((bindings (cdr map))
  97.           (mappings nil))
  98.       (while bindings
  99.         (let* ((binding (car bindings))
  100.            (keys (concat prefix (char-to-string (car binding)))))
  101.           (if (keymapp (cdr binding))
  102.           (setq mappings
  103.             (nconc (evi-keymap-bindings2 (cdr binding) keys)
  104.                    mappings))
  105.         (setq mappings (cons (cons keys (cdr binding)) mappings))))
  106.         (setq bindings (cdr bindings)))
  107.       mappings))))
  108.   ((eq evi-emacs-version 'emacs19)
  109.     (defun evi-fill-keymap (keymap def)
  110.       (fillarray (car (cdr keymap)) def))
  111.  
  112.     (defun evi-keymap-bindings (map)
  113.       (evi-keymap-bindings2 map ""))
  114.  
  115.     (defun evi-keymap-bindings2 (map prefix)
  116.       (let ((bindings (cdr map))
  117.         (mappings nil))
  118.     (while bindings
  119.       (if (vectorp (car bindings))
  120.           (setq mappings
  121.             (nconc (evi-vector-keymap-bindings (car bindings) prefix)
  122.                mappings))
  123.         (let* ((binding (car bindings))
  124.            (key (if (integerp (car binding))
  125.                 (char-to-string (car binding))
  126.               (concat "<" (prin1-to-string (car binding)) ">")))
  127.            (keys (concat prefix key)))
  128.           (if (keymapp (cdr binding))
  129.           (setq mappings
  130.             (nconc (evi-keymap-bindings2 (cdr binding) keys)
  131.                    mappings))
  132.         (setq mappings (cons (cons keys (cdr binding)) mappings)))))
  133.       (setq bindings (cdr bindings)))
  134.     mappings))
  135.  
  136.     (defun evi-vector-keymap-bindings (map prefix)
  137.       (let ((i 0)
  138.         (len (length map))
  139.         (binding)
  140.         (keys)
  141.         (mappings nil))
  142.     (while (< i len)
  143.       (setq binding (aref map i))
  144.       (if binding
  145.           (progn
  146.         (setq keys (concat prefix (char-to-string i)))
  147.         (if (keymapp binding)
  148.             (setq mappings
  149.               (nconc (evi-keymap-bindings2 binding keys)
  150.                  mappings))
  151.           (setq mappings (cons (cons keys binding) mappings)))))
  152.       (setq i (1+ i)))
  153.     mappings)))
  154.   ((eq evi-emacs-version 'lucid19)
  155.     (defun evi-fill-keymap (keymap def)
  156.       (let ((i 128))
  157.     (while (<= 0 (setq i (1- i)))
  158.       (define-key keymap (make-string 1 i) def))
  159.     keymap))
  160.  
  161.     (defun evi-keymap-bindings (map)
  162.       (let ((mappings nil))
  163.     (evi-keymap-bindings2 map "")
  164.     mappings))
  165.  
  166.     (defun evi-keymap-bindings2 (map prefix)
  167.       (map-keymap
  168.        (function
  169.      (lambda (key def)
  170.        (let* ((keys (concat prefix (single-key-description key))))
  171.          (if (keymapp def)
  172.          (setq mappings
  173.                (nconc (evi-keymap-bindings2 def keys) mappings))
  174.            (setq mappings
  175.              (cons (cons keys def) mappings)))))) map))))
  176.  
  177. (defvar evi-initialized nil)
  178.  
  179. (defvar evi-interactive t)
  180.  
  181. (defvar evi-mode-hook nil
  182.   "*Function or functions called upon entry to evi.")
  183.  
  184. (defvar evi-mode-exit-hook nil
  185.   "*Function or functions called upon exit from evi.")
  186.  
  187. (evi-defbuffervar evi-enabled nil
  188.   "If t, currently emulating vi in this buffer.")
  189.  
  190. (defvar evi-debug nil
  191.   "If t, errors generated by emacs are not handled.")
  192.  
  193. (defvar evi-suppress-ex-startup nil
  194.   "If t, don't source .exrc or EXINIT at startup.")
  195.  
  196. (defvar evi-report-unsupported-options nil
  197.   "If t, give an error if a :set option is used that isn't supported.
  198. Otherwise, these are silently ignored.")
  199.  
  200. (evi-defbuffervar evi-mode 'vi
  201.   "Current vi mode, one of vi, insert or replace.")
  202.  
  203. (evi-defbuffervar evi-mode-string nil
  204.   "String describing current evi mode.  This is displayed in the mode line.")
  205.  
  206. (defvar evi-quit-function 'ex-quit-internal
  207.   "Function to invoke when user `quits' evi.  Default is to kill emacs.")
  208.  
  209. (defvar evi-timed-out nil)
  210.  
  211. ; vi-style macro support vars
  212. (defvar evi-unread-command-char nil)
  213. (defvar evi-macro-stack nil)
  214. (defvar evi-current-macro nil)
  215. (defvar evi-current-macro-index nil)
  216.  
  217. ; repeat (`.') support vars
  218. (defvar evi-command-keys-length 256)
  219. (defvar evi-command-keys (make-string evi-command-keys-length 0)
  220.   "The keystrokes for the current command.")
  221. (defvar evi-last-command-keys nil
  222.   "Command keys for the last complete vi command.")
  223. (defvar evi-command-keys-index 0)
  224. (defvar evi-prompt nil)
  225.  
  226. ; replace-mode vars
  227. (defvar evi-replaced-string nil)
  228. (defvar evi-replaced-string-index nil)
  229.  
  230. (defvar evi-minibuf-contents nil
  231.   "Contents of last minibuf read.")
  232.  
  233. (evi-defbuffervar evi-in-minibuf nil
  234.   "If t, we are currently editing in the minibuffer")
  235.  
  236. (defvar evi-enable-emacs-commands nil
  237.   "If t, emacs commands will be visible")
  238.  
  239. (defvar evi-meta-prefix-char nil
  240.   "Meta-prefix-char to use while in Evi buffers.")
  241.  
  242. (defvar evi-emacs-meta-prefix-char nil
  243.   "Meta-prefix-char that emacs uses.")
  244.  
  245. (defvar evi-parameterized-macro nil
  246.   "If t, currently executing a parameteized macro.")
  247.  
  248. (defvar ex-input-escapes nil
  249.   "If t, backslash escapes in ex commands will be processed.")
  250.  
  251. (defvar evi-read-only-buffers nil
  252.   "If t, read-only files will have read-only buffers")
  253.  
  254. (defvar evi-last-point nil
  255.   "Used to calculate line number updates.")
  256.  
  257. (defvar evi-mark nil
  258.   "Used to define regions for operator commands.")
  259.  
  260. (defvar evi-prev-file nil
  261.   "Filename of previous file edited.")
  262.  
  263. (defvar evi-directory-stack nil)
  264.  
  265. (defvar evi-process-buffer nil)
  266.  
  267. (defvar evi-abbrev-list nil)
  268.  
  269. (evi-defbuffervar evi-emacs-local-map nil
  270.   "Emacs' local map.  \(buffer specific\)")
  271.  
  272. (defvar evi-emacs-local-suppress-key-list '(?\b ?\t ?\e ?\C-?)
  273.   "Keys from emacs local map that are to be suppressed.")
  274.  
  275. (defvar evi-prompted nil
  276.   "If t, the current command was prompted for.")
  277.  
  278. (evi-defbuffervar evi-replace-max nil
  279.   "Maximum excursion of a replace, after which it switches to insert.")
  280.  
  281. (evi-defbuffervar evi-overstruck-char nil
  282.   "Value of the character overstruck by the `$' marking a partial line change.")
  283.  
  284. (evi-defbuffervar evi-context nil
  285.   "Current motion context.  One of to-end, to-next, whole-line, or nil.
  286. The value of this variable is passed to evi-motion-command, and is set by
  287. prefix operators like 'd' or '>' to control the type of region defined by
  288. the following motion command.")
  289.  
  290. (defvar evi-prefix-count nil
  291.   "Current prefix count.")
  292.  
  293. (defvar evi-last-prefix-count nil
  294.   "Last prefix count.")
  295.  
  296. (defvar evi-prefix-count-multiplier nil
  297.   "Current prefix count multiplier.")
  298.  
  299. (defvar evi-register-spec nil
  300.   "Current register to use for deletes, yanks, puts, etc.")
  301.  
  302. (defvar evi-last-register-spec nil
  303.   "Last register used for deletes, yanks, puts, etc.")
  304.  
  305. (defvar evi-digit-register 8
  306.   "Current delete-ring register cursor.  Points to the register that
  307. will be register 1.")
  308.  
  309. (defvar evi-repeat-count 0
  310.   "The number of times the current command has been repeated via `.'.")
  311.  
  312. (defvar evi-hidden-repeat-count 0
  313.   "The hidden copy of evi-repeat-count, which isn't visible unless actually
  314. repeating a command.")
  315.  
  316. (defvar evi-last-macro-register nil
  317.   "Last register used to invoke a macro via \\[evi-register-macro].")
  318.  
  319. (defvar evi-registers (make-vector 72 nil)
  320.   "Vi registers.  0-8 are the delete ring, 9 is the unnamed text register,
  321. 10-35 are the alphabetic text registers, and 36-71 are the mark registers.
  322. Each text register is a cons cell with the car being the text in the register
  323. and the cdr being a flag indicating whether or not the text is whole lines.")
  324.  
  325. (defvar evi-register-unnamed 9
  326.   "Symbolic name for the unnamed register.  Shouldn't change.")
  327.  
  328. (defvar evi-region-shape 'chars
  329.   "Specifies the shape of the region for the current operation - one of
  330. chars, lines, or rectangle.  The value of this variable is stored in the cdr
  331. of any register that gets stored as a result of the current command.")
  332.  
  333. (evi-defbuffervar evi-current-indentation 0
  334.   "The indentation of the most recently auto-indented line.  Used by
  335. evi-newline to determine when to kill auto-indented whitespace.
  336. \(buffer specific\)")
  337.  
  338. (evi-defbuffervar evi-goal-column 0
  339.   "The column that vertical cursor motion will try to preserve, if possible.")
  340.  
  341. (evi-defbuffervar evi-reset-goal-column t
  342.   "If t, a horizontal motion has been performed, thus goal column must be reset.")
  343.  
  344. (defvar evi-search-pattern nil
  345.   "The last pattern specified for searching.")
  346.  
  347. (defvar evi-search-forward t
  348.   "If t, the last search command was a forward search.")
  349.  
  350. (defvar evi-find-character nil
  351.   "The last character specified for finding.")
  352.  
  353. (defvar evi-find-forward t
  354.   "If t, the last find command was a forward search.")
  355.  
  356. (defvar evi-find-up-to nil
  357.   "If t, the last find command was a find up to command.")
  358.  
  359. (defvar ex-previous-re nil
  360.   "Last regular expression searched for in :subst command.")
  361.  
  362. (defvar ex-previous-replacement nil
  363.   "Last replacement used in :subst command.")
  364.  
  365. (evi-defbuffervar evi-context-ring (make-vector 10 nil)
  366.   "The last 10 contexts for this buffer.  A context is a location in the buffer
  367. where only relative motions were performed.  A new context is thus saved each
  368. time a non-relative motion is performed.")
  369.  
  370. (evi-defbuffervar evi-context-ring-cursor 0
  371.   "The cursor pointing to the last context in the context ring.")
  372.  
  373. (defvar evi-last-shell-command nil
  374.   "The last shell command run.")
  375.  
  376. (defvar ex-work-space (get-buffer-create " *ex-work-space*")
  377.   "Evi work space for parsing ex commands.")
  378.  
  379. (defvar ex-tag nil
  380.   "Last tag specified.")
  381.  
  382. (defun evi-make-keymap (name small &optional fill)
  383.   (let ((map (if small (make-sparse-keymap) (make-keymap))))
  384.     (if (fboundp 'set-keymap-name)
  385.     (set-keymap-name map name))
  386.     (if fill
  387.     (evi-fill-keymap map fill))
  388.     map))
  389.  
  390. (defconst evi-top-level-map
  391.   (evi-make-keymap 'evi-top-level-map nil 'evi-top-level))
  392.  
  393. (defconst evi-vi-map (evi-make-keymap 'evi-vi-map nil)
  394.   "The keymap used in vi mode.")
  395.  
  396. (defconst evi-param-map (evi-make-keymap 'evi-param-map t)
  397.   "The keymap used for parameterized macros.")
  398.  
  399. (defconst evi-motion-map (evi-make-keymap 'evi-motion-map nil)
  400.   "The keymap used for operand motions.")
  401.  
  402. (defconst evi-map-map (evi-make-keymap 'evi-map-map t)
  403.   "The keymap used for map macros.")
  404.  
  405. (defconst evi-input-map (evi-make-keymap 'evi-input-map nil 'evi-self-insert)
  406.   "The keymap used in input modes.")
  407.  
  408. (defconst evi-replace-map
  409.   (evi-make-keymap 'evi-replace-map nil 'evi-self-replace)
  410.   "The keymap used in replace mode.")
  411.  
  412. (defconst evi-insert-map (evi-make-keymap 'evi-insert-map t)
  413.   "The insert mode specific input map.")
  414.  
  415. (defconst evi-read-string-map (evi-make-keymap 'evi-read-string-map t)
  416.   "The evi-read-string specific command map.")
  417.  
  418. (defconst evi-read-string-input-map
  419.   (evi-make-keymap 'evi-read-string-input-map t)
  420.   "The evi-read-string specific input map.")
  421.  
  422. (defconst evi-ex-map (evi-make-keymap 'evi-ex-map t)
  423.   "The keymap used when reading ex commands from the minibuffer")
  424.  
  425. (defconst evi-ex-input-map (evi-make-keymap 'evi-ex-input-map t)
  426.   "The keymap used when reading ex commands from the minibuffer (insert-mode)")
  427.  
  428. (defconst evi-input-map-map (evi-make-keymap 'evi-input-map-map t)
  429.   "The keymap used for input map macros.")
  430.  
  431. (defconst evi-shell-map (evi-make-keymap 'evi-shell-map t)
  432.   "The local keymap used in command mode in a shell buffer.")
  433.  
  434. (evi-defbuffervar evi-buffer-local-vi-map
  435.   (evi-make-keymap 'evi-buffer-local-vi-map t)
  436.   "The keymap for buffer specific additions to the vi command map")
  437.  
  438. (evi-defbuffervar evi-buffer-local-input-map
  439.   (evi-make-keymap 'evi-buffer-local-vi-map t)
  440.   "The keymap for buffer specific additions to input maps")
  441.  
  442. (defvar evi-Z-map (evi-make-keymap 'evi-Z-map t))
  443. (defvar evi-lbrack-map (evi-make-keymap 'evi-lbrack-map t))
  444. (defvar evi-lbrack-m-map (evi-make-keymap 'evi-lbrack-m-map t))
  445. (defvar evi-rbrack-map (evi-make-keymap 'evi-rbrack-map t))
  446.  
  447. (cond ((eq evi-emacs-version 'emacs19)
  448.         (defconst evi-vi-keymap-list 
  449.       (list (cons 'param evi-param-map) (cons 'map evi-map-map)
  450.         'evi-buffer-local-vi-map evi-vi-map
  451.         (cons 'minor nil)
  452.         (cons 'cond-emacs (cons 'local nil))
  453.         (cons 'cond-emacs (cons 'global nil)))))
  454.       ((eq evi-emacs-version 'lucid19)
  455.         (defconst evi-vi-keymap-list 
  456.       (list (cons 'param evi-param-map) (cons 'map evi-map-map)
  457.         'evi-buffer-local-vi-map evi-vi-map
  458.         (cons 'minor nil)
  459.         (cons 'cond-emacs (cons 'local nil))
  460.         (cons 'cond-emacs (cons 'global nil)))))
  461.       (t
  462.         (defconst evi-vi-keymap-list 
  463.       (list (cons 'param evi-param-map) (cons 'map evi-map-map)
  464.         evi-buffer-local-vi-map evi-vi-map
  465.         (cons 'cond-emacs (cons 'global nil))))))
  466.  
  467. (evi-defbuffervar evi-keymap-list nil
  468.   "Keymap list")
  469.  
  470. (defconst evi-all-keymaps '(vi insert replace ex)
  471.   "All Evi keymaps.")
  472.  
  473. (evi-defbuffervar evi-register-parameter nil
  474.   "Register specification to the current parameterized macro.")
  475.  
  476. (evi-defbuffervar evi-prefix-count-parameter nil
  477.   "Prefix count to the current parameterized macro.")
  478.  
  479. (evi-defbuffervar evi-insert-point nil
  480.   "The point at which the current insert command began.")
  481.  
  482. ;; Vi option variables
  483. ;; ZZ - could/should make some of these buffer local after reading EXINIT
  484.  
  485. (defconst evi-option-list
  486.   '((("autoindent" "ai") . (bool . evi-auto-indent))
  487.     (("autoprint" "ap") . (bool . nil))
  488.     (("autowrite" "aw") . (bool . nil))
  489.     (("backslash-escapes" "be") . (bool . ex-input-escapes))
  490.     (("beautify") . (bool . nil))
  491.     (("command-line-editing" "cle") . (bool . evi-command-line-editing))
  492.     (("directory" "dir") . (string . nil))
  493.     (("edcompatible" "ed") . (bool . nil))
  494.     (("enable-emacs-commands" "ee") . (bool . evi-enable-emacs-commands))
  495.     (("errorbells" "eb") . (bool . evi-error-bell))
  496.     (("exrc") . (bool . evi-local-exrc))
  497.     (("flash") . (bool . nil))
  498.     (("global-directory" "gd") . (bool . evi-global-directory))
  499.     (("hardtabs" "ht") . (number . nil))
  500.     (("ignorecase" "ic") . (bool . evi-ignore-case))
  501.     (("inhibit-startup-message" "ism") . (bool . evi-inhibit-startup-message))
  502.     (("ishell" "ish") . (string . explicit-shell-file-name))
  503.     (("lisp") . (bool . nil))
  504.     (("list") . (bool . nil))
  505.     (("magic") . (bool . evi-search-magic))
  506.     (("mesg") . (bool . nil))
  507.     (("meta-prefix" "mp") . (char . evi-meta-prefix-char))
  508.     (("modeline") . (bool . nil))
  509.     (("mode-specific-insert-bindings" "msb") .
  510.      (bool . evi-insert-mode-local-bindings))
  511.     (("modified-paragraph") . (bool . evi-modified-paragraph))
  512.     (("novice") . (bool . nil))
  513.     (("number" "nu") . (bool . evi-number))
  514.     (("optimize" "opt") . (bool . nil))
  515.     (("paragraphs" "para") . (string . nil))
  516.     (("parens") . (string . evi-parens))
  517.     (("prompt") . (bool . nil))
  518.     (("readonly" "ro") . (bool . evi-buffer-read-only))
  519.     (("readonly-buffers") . (bool . evi-read-only-buffers))
  520.     (("redraw") . (bool . nil))
  521.     (("remap") . (bool . evi-remap))
  522.     (("report") . (number . evi-report-limit))
  523.     (("ruler") . (bool . nil))
  524.     (("scroll") . (number . evi-scroll-count))
  525.     (("sections" "sect") . (string . nil))
  526.     (("shell" "sh") . (string . shell-file-name))
  527.     (("shiftwidth" "sw") . (number . evi-shift-width))
  528.     (("showmatch" "sm") . (bool . evi-show-match))
  529.     (("showmode") . (bool . evi-show-mode))
  530.     (("sidescroll") . (number . nil))
  531.     (("slowopen" "slow") . (bool . nil))
  532.     (("sourceany") . (bool . nil))
  533.     (("tabstop" "ts") . (number . evi-tab-width))
  534.     (("tags") . (string . nil))
  535.     (("taglength" "tl") . (number . nil))
  536.     (("term") . (string . nil))
  537.     (("terse") . (bool . nil))
  538.     (("timeout") . (bool . evi-timeout))
  539.     (("timeoutlen") . (number . evi-timeout-length))
  540.     (("ttytype" "tty") . (string . nil))
  541.     (("warn") . (bool . nil))
  542.     (("word") . (string . evi-word))
  543.     (("Word") . (string . evi-Word))
  544.     (("wrapmargin" "wm") . (number . evi-wrap-margin))
  545.     (("wrapscan" "ws") . (bool . evi-search-wraparound))
  546.     (("writeany" "wa") . (bool . nil))))
  547.  
  548. (defvar evi-set-options nil
  549.   "List of options that have been set.")
  550.  
  551. (defvar evi-auto-indent nil
  552.   "*If t, automatically indents text inserted on a new line.")
  553.  
  554. (defvar evi-command-line-editing nil
  555.   "*If t, command-line editing is enabled.")
  556.  
  557. (defun evi-command-line-editing (enable)
  558.   (evi-define-key '(read-string read-string-input ex ex-input)
  559.           "\e" (if enable nil 'evi-exit-minibuf)))
  560.  
  561. (defvar evi-error-bell nil
  562.   "*If t, ring bell on error.")
  563.  
  564. (defvar evi-local-exrc nil
  565.   "*If t, source local .exrc file at startup.")
  566.  
  567. (defvar evi-global-directory t
  568.   "*If t, a global current directory is used (this is the default).")
  569.  
  570. (defvar evi-ignore-case nil
  571.   "*If t, ignore case in searches.")
  572.  
  573. (defvar evi-search-magic t
  574.   "*If t, search patterns are normal regular expressions.  This is the default.
  575. Otherwise, the `magic' characters `.' `[' and `*' are treated as literals and
  576. must be escaped to get their regular expression interpretation.")
  577.  
  578. (defvar evi-insert-mode-local-bindings nil
  579.   "*If t, emacs buffer-local key bindings will be enabled in insert mode.")
  580.  
  581. (defvar evi-modified-paragraph nil
  582.   "*If t, a modified paragraph motion will be used that is similar to
  583. sentence motion.")
  584.  
  585. (defvar evi-number nil
  586.   "*If t, tracks line and column number in status line (NOT).")
  587.  
  588. (defvar evi-parens "()[]{}"
  589.   "*The set of parentheses that `%' will match.")
  590.  
  591. (defvar evi-parens-match "[][(){}]")
  592.  
  593. (defun evi-parens (parens)
  594.   (let* ((found-rbrack nil)
  595.      (parens-match
  596.       (mapconcat
  597.        (function (lambda (c)
  598.                (if (/= c ?\])
  599.                (char-to-string c)
  600.              (setq found-rbrack t)
  601.              "")))
  602.        parens "")))
  603.     (if found-rbrack
  604.     (setq evi-parens-match (concat "[]" parens-match "]"))
  605.       (setq evi-parens-match (concat "[" parens-match "]")))))
  606.  
  607. (evi-defbuffervar evi-buffer-read-only nil
  608.   "*If t, the current buffer is read-only")
  609.  
  610. (defvar evi-remap t
  611.   "*If t, nested map macros are expanded")
  612.  
  613. (defvar evi-report-limit 4
  614.   "*Any action affecting more than this many lines displays a message.")
  615.  
  616. ; The following is used by evi-report-limit
  617. (defvar ex-lines-changed 0
  618.   "*Counts how many lines are added or deleted during a global ex operation.")
  619.  
  620. (defvar evi-scroll-count nil
  621.   "*The number of lines to scroll.")
  622.  
  623. (defvar evi-shift-width 8
  624.   "*The number of colums shifted by > and < command, and ^T and ^D
  625. in insert mode.")
  626.  
  627. (defvar evi-show-match nil
  628.   "*If t, show matching parentheses.")
  629.  
  630. (defun evi-show-match (val)
  631.   (setq blink-matching-paren val))
  632.  
  633. (defvar evi-show-mode t
  634.   "*If t, show current vi mode.")
  635.  
  636. (defvar evi-tab-width 8
  637.   "*Distance between tab stops")
  638.  
  639. (defun evi-tab-width (width)
  640.   (setq tab-width width))
  641.  
  642. (defvar evi-timeout t
  643.   "*If t, keys in multi-character maps must be typed within one second of each
  644. other, otherwise the partial command aborted.")
  645.  
  646. (defvar evi-timeout-length 500
  647.   "*Not implemented.")
  648.  
  649. (defvar evi-word "[a-zA-Z0-9_]+\\|[^a-zA-Z0-9_ \t\n]+\\|^[ \t]*\n"
  650.   "*Regular expression to describe words for w, b and e commands.")
  651.  
  652. (defvar evi-Word "[^ \t\n]+\\|^[ \t]*\n"
  653.   "*Regular expression to describe words for W, B and E commands.")
  654.  
  655. (defvar evi-wrap-margin 0
  656.   "*If non-zero, the amount of right margin past which wraparound occurs.")
  657.  
  658. (defun evi-wrap-margin (margin)
  659.   (if (eq evi-emacs-version 'emacs18)
  660.       (if (= margin 0)
  661.       (setq auto-fill-hook nil)
  662.     (setq fill-column (- (window-width) margin)
  663.           auto-fill-hook 'do-auto-fill))
  664.     (if (= margin 0)
  665.     (setq auto-fill-function nil)
  666.       (setq fill-column (- (window-width) margin)
  667.         auto-fill-function 'do-auto-fill))))
  668.  
  669. (defvar evi-search-wraparound t
  670.   "*If t, search wraps around the end of the file.")
  671.  
  672. ;; these are intended to be ordered roughly in order of frequency of use
  673. (defvar ex-commands
  674.   '((("edit" . 1) . ((0 . ((nil . "!") (t . offset) (t . file))) . ex-edit))
  675.     (("buffer" . 1) . ((0 . ((nil . "!") (t . buffer))) . ex-change-buffer))
  676.     (("read" . 1) .
  677.      ((1 . ((t . (if "!" shell-command)) (t . file))) . ex-read))
  678.     (("write" . 1) . ((2 . ((nil . "!")
  679.                 (t . (if "!" shell-command))
  680.                 (t . ">>") (t . file))) . ex-write))
  681.     (("kill" . 1) . ((0 . ((nil . "!") (t . buffer))) . ex-kill-buffer))
  682.     (("next" . 1) . ((0 . ((nil . "!") (t . files))) . ex-next))
  683.     (("Edit" . 1) .
  684.      ((0 . ((nil . "!") (nil . offset) (t . file))) . ex-edit-other-window))
  685.     (("Buffer" . 1) .
  686.      ((0 . ((nil . "!") (t . buffer))) . ex-change-buffer-other-window))
  687.     (("Kill" . 1) .
  688.      ((0 . ((nil . "!") (t . buffer))) . ex-kill-buffer-delete-windows))
  689.     (("Write" . 1) . ((0 . ((nil . "!"))) . ex-write-all-buffers))
  690.     (("Next" . 1) . ((0 . ((nil . "!") (t . files))) . ex-next-other-window))
  691.     (("split" . 2) . ((0 . ((t . file))) . ex-split))
  692.     (("set" . 2) . ((0 . ((nil . settings))) . ex-set))
  693.     (("substitute" . 1) .
  694.      ((2 . ((t . regular-expression) (backup . regular-expression2)
  695.         (nil . "g") (nil . "c"))) . ex-substitute))
  696.     (("global" . 1) .
  697.      ((2 . ((nil . "!") (t . regular-expression) (t . command))) . ex-global))
  698.     (("vglobal" . 1) .
  699.      ((2 . ((t . regular-expression) (t . command))) . ex-vglobal))
  700.     (("map" . 3) .
  701.      ((0 . ((nil . "!") (t . map) (t . words))) . ex-map))
  702.     (("gdb" . 2) . ((0 . ((t . file))) . ex-gdb))
  703.     (("wk" . 2) . ((0 . nil) . ex-write-kill))
  704.     (("wq" . 2) . ((0 . ((nil . "!"))) . ex-write-quit))
  705.     (("Wq" . 2) . ((0 . ((nil . "!"))) . ex-write-all-and-quit))
  706.     (("visual" . 2) . ((0 . ((nil . "!") (t . offset) (t . file))) . ex-edit))
  707.     (("Visual" . 2) .
  708.      ((0 . ((nil . "!") (nil . offset) (t . file))) . ex-edit-other-window))
  709.     (("abbreviate" . 2) .
  710.      ((0 . ((t . abbrev) (t . words))) . ex-abbrev))
  711.     (("append" . 1) . ((1 . nil) . ex-not-implemented))
  712.     (("args" . 2) . ((0 . nil) . ex-not-implemented))
  713.     (("bind" . 2) .
  714.      ((0 . ((nil . "!") (t . word) (t . rest-of-line))) . ex-elisp-bind))
  715.     (("bug" . 3) . ((0 . ((t . words))) . ex-report-bug))
  716.     (("cd" . 2) . ((0 . ((t . file))) . ex-change-directory))
  717.     (("change" . 1) . ((2 . nil) . ex-not-implemented))
  718.     (("chdir" . 3) . ((0 . ((t . file))) . ex-change-directory))
  719.     (("copy" . 2) . ((2 . ((t . address))) . ex-copy))
  720.     (("delete" . 1) . ((2 . ((t . register))) . ex-delete))
  721.     (("dirs" . 2) . ((0 . nil) . ex-directory-stack))
  722.     (("elisp" . 2) . ((0 . ((t . rest-of-line))) . ex-elisp-execute))
  723.     (("evilist" . 4) . ((0 . ((t . words))) . ex-mail-list))
  724.     (("file" . 1) . ((0 . ((t . file))) . ex-file))
  725.     (("insert" . 1) . ((1 . nil) . ex-not-implemented))
  726.     (("join" . 1) . ((2 . nil) . ex-not-implemented))
  727.     (("killprocess" . 5) . ((0 . ((t . process))) . delete-process))
  728.     (("list" . 1) . ((2 . nil) . ex-not-implemented))
  729.     (("mail" . 3) . ((0 . ((t . words))) . ex-mail))
  730.     (("mark" . 2) . ((1 . ((t . mark))) . ex-mark))
  731.     (("move" . 1) . ((2 . ((t . address))) . ex-move))
  732.     (("number" . 2) . ((2 . nil) . ex-not-implemented))
  733.     (("popd" . 2) . ((0 . nil) . ex-pop-directory))
  734.     (("preserve" . 3) . ((0 . nil) . ex-preserve))
  735.     (("previous" . 4) . ((0 . nil) . ex-not-implemented))
  736.     (("print" . 1) . ((2 . nil) . ex-print))
  737.     (("pushd" . 4) . ((0 . ((t . file))) . ex-push-directory))
  738.     (("put" . 2) . ((1 . ((t . register))) . ex-put))
  739.     (("quit" . 1) . ((0 . ((nil . "!"))) . ex-quit))
  740.     (("recover" . 3) . ((0 . ((nil . "!") (t . file))) . ex-recover))
  741.     (("initialize" . 3) . ((0 . nil) . ex-initialize))
  742.     (("rewind" . 3) . ((0 . nil) . ex-not-implemented))
  743.     (("send" . 3) . ((0 . ((nil . "!"))) . ex-send-mail))
  744.     (("shell" . 2) . ((0 . nil) . ex-shell))
  745.     (("source" . 2) . ((0 . ((t . file))) . ex-source-file))
  746.     (("tag" . 1) . ((0 . ((t . word))) . ex-tag))
  747.     (("unabbreviate" . 3) . ((0 . ((t . abbrev))) . ex-unabbrev))
  748.     (("undo" . 1) . ((0 . nil) . ex-not-implemented))
  749.     (("unmap" . 3) . ((0 . ((nil . "!") (t . word))) . ex-unmap))
  750.     (("version" . 2) . ((0 . nil) . ex-evi-version))
  751.     (("xit" . 1) . ((0 . ((nil . "!"))) . ex-write-all-and-quit))
  752.     (("yank" . 1) . ((2 . ((t . register))) . ex-yank))
  753.     (("!" . 1) . ((2 . ((nil . "&") (t . shell-command))) . ex-shell-command))
  754.     (("<" . 1) . ((2 . nil) . ex-shift-left))
  755.     (("=" . 1) . ((2 . nil) . ex-not-implemented))
  756.     ((">" . 1) . ((2 . nil) . ex-shift-right))
  757.     (("&" . 1) . ((2 . nil) . ex-substitute-again))
  758.     (("@" . 1) . ((2 . nil) . ex-not-implemented))
  759.     (("" . 0) . ((2 . nil) . ex-null)))
  760. "Ex commands table
  761.  
  762. The car of an item in the list is a pair of the full name of a command with
  763. the length of the shortest prefix that's unambiguous.  The cdr of an item
  764. is a pair of a description of arguments with the name of the lisp function
  765. to invoke for this command.  The description of argument is a pair of the
  766. number of addresses this command accepts and a list describing its
  767. subsequent arguments and how to parse them.  Each element of the list of
  768. subsequent argument descriptions is a pair.  The car of this pair is `t'
  769. if the parser should eat whitespace before the arg, and `nil' if it
  770. shouldn't.  The cdr describes the argument itself.  The possible values
  771. are as follows (symbols are indicated by prefixing with \"'\", asterisked
  772. items are completable):
  773.       a string            literally match that string
  774.       'address            an ex line address
  775.       'register            a register name
  776.     * 'file            a file name (`%', `#' and wildcards are expanded)
  777.     * 'files            several file names (similarly expanded)
  778.     * 'buffer            a buffer name (can include spaces)
  779.       'rest-of-line        the rest of the line (can include `|')
  780.     * 'process            a process name (can include spaces and `|')
  781.       'word            a space-delimited word
  782.       'words            several words
  783.     * 'map            a :map macro name
  784.     * 'abbrev            an :abbrev macro name
  785.       'regular-expression   a regular expression
  786.       'regular-expression2  same but `&' is special
  787.       'command            an ex command
  788.     * 'settings            :set settings (`wm=8', etc)
  789.     * 'shell-command        a shell command (`%', `#' are expanded)
  790.       'offset            a line offset (`+5')
  791.       'mark            a mark
  792.  
  793. In summary (postfix `*' means `list-of'):
  794.  
  795.    ((full-name . prefix-len) .
  796.     ((num-of-addrs . (eat-whitespace? . arg-descr)*) . lisp-function))")
  797.  
  798.  
  799. ;; Macros
  800.  
  801. (defmacro evi-defmotion (&rest args)
  802.   (let* ((direction (car args))
  803.      (function (car (cdr args)))
  804.      (params (nth 2 args))
  805.      (documentation (nth 3 args))
  806.      (body (nthcdr 4 args))
  807.      (do-function (intern (concat "do-" (symbol-name function)))))
  808.     ; ZZ some rather narly hard-coding here, but does the trick for now
  809.     (cond ((eq (car params) '&char)
  810.         (` (progn (defun (, function) () (, documentation)
  811.             (interactive)
  812.             (evi-motion-command (quote (, do-function))
  813.                         (quote (, direction))
  814.                         (evi-adjust-count) evi-context
  815.                         (evi-read-command-char)))
  816.               (defun (, do-function) (, (cdr params)) (,@ body)))))
  817.       ((eq (car params) '&string)
  818.         (` (progn (defun (, function) () (, documentation)
  819.             (interactive)
  820.             (evi-extend-continuation
  821.               'evi-after-string-arg
  822.               (list 'quote (quote (, do-function)))
  823.               (list 'quote (quote (, direction)))
  824.               (evi-adjust-count) (list 'quote evi-context))
  825.             (evi-read-string (, (car (cdr params)))))
  826.               (defun (, do-function) (, (cdr (cdr params)))
  827.             (,@ body)))))
  828.       (t
  829.         (` (progn (defun (, function) () (, documentation)
  830.             (interactive)
  831.             (evi-motion-command
  832.               (quote (, do-function)) (quote (, direction))
  833.               (evi-adjust-count) evi-context))
  834.               (defun (, do-function) (, params) (,@ body))))))))
  835.  
  836. (defun evi-after-string-arg (func dir count context)
  837.   (evi-motion-command func dir count context evi-minibuf-contents))
  838.  
  839. (defmacro evi-iterate (count &rest body)
  840.   (list 'let (list (list 'count count))
  841.       (append (list 'while (list '> 'count 0)) body
  842.           (list (list 'setq 'count (list '1- 'count))))
  843.       (list '= 'count 0)))
  844.  
  845. (defmacro evi-break ()
  846.   (list 'setq 'count -1))
  847.  
  848. (defmacro evi-enumerate-condition (item list condition &rest body)
  849.   (list 'let (list (list 'list list) (list item))
  850.     (append
  851.       (list 'while
  852.     (list 'and 'list
  853.           (list 'progn (list 'setq item '(car list)) condition)))
  854.       (if body
  855.     (append body '((setq list (cdr list))))
  856.     '((setq list (cdr list)))))
  857.     'list))
  858.  
  859. (defmacro evi-iterate-list (item list &rest body)
  860.   (list 'let (list (list 'list list) (list item) '(found))
  861.     (append
  862.       (list 'while 'list)
  863.       (append (list (list 'setq item '(car list)))
  864.           body '((setq list (cdr list)))))))
  865.  
  866. (defmacro evi-find (item list pred)
  867.   (list 'let (list (list 'list list) (list item) '(found))
  868.     (list 'while
  869.       (list 'and 'list
  870.         (list 'progn (list 'setq item '(car list) 'found pred)
  871.              '(not found)))
  872.       '(setq list (cdr list)))
  873.     'found))
  874.  
  875. (defmacro evi-set-goal-column ()
  876.   (` (if evi-reset-goal-column
  877.        (setq evi-goal-column (current-column)
  878.          evi-reset-goal-column nil))))
  879.  
  880. (defmacro evi-reset-goal-column ()
  881.   (` (setq evi-reset-goal-column t)))
  882.  
  883. (defmacro evi-register-text (register)
  884.   (list 'car register))
  885.  
  886. (defmacro evi-register-shape (register)
  887.   (list 'cdr register))
  888.  
  889. ;; Keymaps
  890.  
  891. (defun evi-define-key (maps key def)
  892.   (evi-enumerate-condition map maps t
  893.     (funcall 'define-key
  894.          (symbol-value (intern (concat "evi-" (symbol-name map) "-map")))
  895.          key def)))
  896.  
  897. (defun evi-define-macro (maps key macro)
  898.   (evi-enumerate-condition map maps t
  899.     (eval (list 'define-key
  900.         (intern (concat "evi-" (symbol-name map) "-map")) 'key
  901.         (list 'quote (list 'lambda ()
  902.           '(interactive) (list 'evi-internal-macro macro)))))))
  903.  
  904. (defun evi-make-local-keymap (keydefs)
  905.   (let ((keymap (make-sparse-keymap)))
  906.     (if (fboundp 'set-keymap-name)
  907.     (set-keymap-name keymap 'evi-local))
  908.     (mapcar '(lambda (keydef)
  909.            (define-key keymap (eval (car keydef)) (nth 1 keydef)))
  910.         keydefs)
  911.     keymap))
  912.  
  913. (defun evi-unbound ()
  914.   (interactive)
  915.   (evi-error "Nothing bound to `%c'" last-command-char))
  916.  
  917. ;                    "\C-a"
  918. (evi-define-key '(vi)            "\C-b" 'evi-scroll-page-backward)
  919. (evi-define-key '(vi)            "\C-c" 'keyboard-quit)
  920. (evi-define-key '(vi)            "\C-d" 'evi-scroll-text-forward)
  921. (evi-define-key '(vi)            "\C-e" 'evi-scroll-cursor-forward)
  922. (evi-define-key '(vi)            "\C-f" 'evi-scroll-page-forward)
  923. (evi-define-key '(vi)            "\C-g" 'evi-file-info)
  924. (evi-define-key '(vi motion)        "\C-h" 'evi-backward-char)
  925. (evi-define-key '(vi)            "\C-i" 'evi-unbound)
  926. (evi-define-key '(vi motion)        "\C-j" 'evi-next-line)
  927. ;                    "\C-k"
  928. (evi-define-key '(vi)            "\C-l" 'evi-redraw)
  929. (evi-define-key '(vi motion)        "\C-m" 'evi-beginning-of-next-line)
  930. (evi-define-key '(vi motion)        "\C-n" 'evi-next-line)
  931. ;                    "\C-o"
  932. (evi-define-key '(vi motion)        "\C-p" 'evi-previous-line)
  933. ;                    "\C-q"
  934. (evi-define-key '(vi)            "\C-r" 'evi-redraw)
  935. ;                    "\C-s"
  936. ;                    "\C-t"
  937. (evi-define-key '(vi)            "\C-u" 'evi-scroll-text-backward)
  938. ;                    "\C-v"
  939. ;                    "\C-w"
  940. ;                    "\C-x"
  941. (evi-define-key '(vi)            "\C-y" 'evi-scroll-cursor-backward)
  942. (evi-define-key '(vi)            "\C-z" 'suspend-emacs)
  943. ;                    "\C-[" (ESC)
  944. ;                    "\C-\"
  945. (evi-define-key '(vi)            "\C-]" 'evi-tag)
  946. (evi-define-key '(vi)            "\C-^" ":e#\n")
  947.  
  948. (evi-define-key '(vi motion)        " " 'evi-forward-char)
  949. (evi-define-key '(vi)            "!" 'evi-shell-filter)
  950. (evi-define-key '(vi)            "\"" 'evi-prefix-register)
  951. (evi-define-key '(vi)            "#" 'evi-unbound)
  952. (evi-define-key '(vi motion)        "$" 'evi-end-of-line)
  953. (evi-define-key '(vi motion)        "%" 'evi-paren-match)
  954. (evi-define-key '(vi)            "&" ":s\n")
  955. (evi-define-key '(vi motion)        "'" 'evi-goto-mark-vertical)
  956. (evi-define-key '(vi motion)        "(" 'evi-backward-sentence)
  957. (evi-define-key '(vi motion)        ")" 'evi-forward-sentence)
  958. (evi-define-key '(vi)            "*" 'evi-send-to-process)
  959. (evi-define-key '(vi motion)        "+" 'evi-beginning-of-next-line)
  960. (evi-define-key '(vi motion)        "," 'evi-find-next-character-reverse)
  961. (evi-define-key '(vi motion)        "-" 'evi-beginning-of-previous-line)
  962. (evi-define-key '(vi)            "." 'evi-repeat)
  963. (evi-define-key '(vi motion)        "/" 'evi-search-forward)
  964. (evi-define-key '(vi motion)        "0" 'evi-digit-or-beginning-of-line)
  965. (evi-define-key '(vi motion)        "1" 'evi-prefix-digit)
  966. (evi-define-key '(vi motion)        "2" 'evi-prefix-digit)
  967. (evi-define-key '(vi motion)        "3" 'evi-prefix-digit)
  968. (evi-define-key '(vi motion)        "4" 'evi-prefix-digit)
  969. (evi-define-key '(vi motion)        "5" 'evi-prefix-digit)
  970. (evi-define-key '(vi motion)        "6" 'evi-prefix-digit)
  971. (evi-define-key '(vi motion)        "7" 'evi-prefix-digit)
  972. (evi-define-key '(vi motion)        "8" 'evi-prefix-digit)
  973. (evi-define-key '(vi motion)        "9" 'evi-prefix-digit)
  974. (evi-define-key '(vi)            ":" 'evi-ex-command)
  975. (evi-define-key '(vi motion)        ";" 'evi-find-next-character)
  976. (evi-define-key '(vi)            "<" 'evi-shift-left)
  977. (evi-define-key '(vi)            "=" 'evi-indent)
  978. (evi-define-key '(vi)            ">" 'evi-shift-right)
  979. (evi-define-key '(vi motion)        "?" 'evi-search-backward)
  980. (evi-define-key '(vi)            "@" 'evi-register-macro)
  981.  
  982. (evi-define-macro '(vi)            "A" "$#a")
  983. (evi-define-key '(vi motion)        "B" 'evi-backward-Word)
  984. (evi-define-macro '(vi)            "C" "&c#$")
  985. (evi-define-macro '(vi)            "D" "&d#$")
  986. (evi-define-key '(vi motion)        "E" 'evi-end-of-Word)
  987. (evi-define-key '(vi motion)        "F" 'evi-find-char-backwards)
  988. (evi-define-key '(vi motion)        "G" 'evi-goto-line)
  989. (evi-define-key '(vi motion)        "H" 'evi-goto-top-of-window)
  990. (evi-define-macro '(vi)            "I" "^#i")
  991. (evi-define-key '(vi)            "J" 'evi-join-lines)
  992. (evi-define-key '(vi)            "K" 'evi-unbound)
  993. (evi-define-key '(vi motion)        "L" 'evi-goto-bottom-of-window)
  994. (evi-define-key '(vi motion)        "M" 'evi-goto-middle-of-window)
  995. (evi-define-key '(vi motion)        "N" 'evi-search-next-reverse)
  996. (evi-define-key '(vi)            "O" 'evi-open-before)
  997. (evi-define-key '(vi)            "P" 'evi-put)
  998. (evi-define-key '(vi)            "Q" 'evi-quit-evi)
  999. (evi-define-key '(vi)            "R" 'evi-replace)
  1000. (evi-define-macro '(vi)            "S" "&c#c")
  1001. (evi-define-key '(vi motion)        "T" 'evi-find-char-backwards-after)
  1002. (if (boundp 'buffer-undo-list)
  1003.     (evi-define-key '(vi)        "U" 'evi-undo-line))
  1004. (evi-define-key '(vi)            "V" 'evi-unbound)
  1005. (evi-define-key '(vi motion)        "W" 'evi-forward-Word)
  1006. (evi-define-macro '(vi)            "X" "&d#h")
  1007. (evi-define-macro '(vi)            "Y" "&y#y")
  1008. (evi-define-key '(vi)            "Z" (cons 'prefix evi-Z-map))
  1009. (evi-define-key '(Z)              "Z" ":Wq!\n")
  1010.  
  1011. (evi-define-key '(vi)            "[" (cons 'prefix evi-lbrack-map))
  1012. (evi-define-key '(motion)        "[" (cons 'prefix evi-lbrack-m-map))
  1013. (evi-define-key '(lbrack)          "\"" 'evi-register-string)
  1014. (evi-define-key '(lbrack)          "'" 'evi-register-char)
  1015. (evi-define-key '(lbrack lbrack-m)      "(" 'evi-parameterized-macro)
  1016. (evi-define-key '(lbrack lbrack-m)      "[" 'evi-backward-section)
  1017. (evi-define-key '(lbrack)          "b" 'evi-buffer-name)
  1018. (evi-define-key '(lbrack)          "u" 'evi-undo-more)
  1019. (evi-define-key '(lbrack)          "{" 'evi-loop-over-lines-in-region)
  1020. (evi-define-key '(vi)            "\\" 'evi-unbound)
  1021. (evi-define-key '(vi motion)        "]" (cons 'prefix evi-rbrack-map))
  1022. (evi-define-key '(rbrack)          "]" 'evi-forward-section)
  1023. (evi-define-key '(vi motion)        "^" 'evi-goto-indentation)
  1024. (evi-define-key '(vi)            "_" 'evi-prompt-repeat)
  1025. (evi-define-key '(vi motion)        "`" 'evi-goto-mark-horizontal)
  1026.  
  1027. (evi-define-key '(vi)            "a" 'evi-insert-after)
  1028. (evi-define-key '(vi motion)        "b" 'evi-backward-word)
  1029. (evi-define-key '(vi)            "c" 'evi-change)
  1030. (evi-define-key '(vi)            "d" 'evi-delete)
  1031. (evi-define-key '(vi motion)        "e" 'evi-end-of-word)
  1032. (evi-define-key '(vi motion)        "f" 'evi-find-character)
  1033. (evi-define-key '(vi)            "g" 'evi-unbound)
  1034. (evi-define-key '(vi motion)        "h" 'evi-backward-char)
  1035. (evi-define-key '(vi)            "i" 'evi-insert)
  1036. (evi-define-key '(vi motion)        "j" 'evi-next-line)
  1037. (evi-define-key '(vi motion)        "k" 'evi-previous-line)
  1038. (evi-define-key '(vi motion)        "l" 'evi-forward-char)
  1039. (evi-define-key '(vi)            "m" 'evi-set-mark)
  1040. (evi-define-key '(vi motion)        "n" 'evi-search-next)
  1041. (evi-define-key '(vi)            "o" 'evi-open-after)
  1042. (evi-define-key '(vi)            "p" 'evi-put-after)
  1043. (evi-define-key '(vi)            "q" 'evi-unbound)
  1044. (evi-define-key '(vi)            "r" 'evi-replace-char)
  1045. (evi-define-macro '(vi)            "s" "&c#l")
  1046. (evi-define-key '(vi motion)        "t" 'evi-find-character-before)
  1047. (evi-define-key '(vi)            "u" 'evi-undo)
  1048. (evi-define-key '(vi)            "v" 'evi-unbound)
  1049. (evi-define-key '(vi motion)        "w" 'evi-forward-word)
  1050. (evi-define-macro '(vi)            "x" "&d#l")
  1051. (evi-define-key '(vi)            "y" 'evi-yank)
  1052. (evi-define-key '(vi)            "z" 'evi-window-control)
  1053.  
  1054. (evi-define-key '(vi motion)        "{" 'evi-backward-paragraph)
  1055. (evi-define-key '(vi motion)        "|" 'evi-goto-column)
  1056. (evi-define-key '(vi motion)        "}" 'evi-forward-paragraph)
  1057. (evi-define-key '(vi)            "~" 'evi-toggle-case)
  1058.  
  1059. (evi-define-key '(param)        "&" 'evi-register-parameter)
  1060. (evi-define-key '(param)        "#" 'evi-prefix-count-parameter)
  1061.  
  1062. (evi-define-key '(motion)        "a" 'evi-region-arbitrary)
  1063. (evi-define-key '(motion)        "m" 'evi-region-mouse)
  1064. (evi-define-key '(motion)        "r" 'evi-region-rectangle)
  1065. (evi-define-key '(motion)        "R" 'evi-region-rows)
  1066. (evi-define-key '(motion)        "C" 'evi-region-columns)
  1067.  
  1068. ; ZZ should define for replace mode also?
  1069. (evi-define-key '(input) "\C-q" 'evi-quoted-insert)
  1070. (evi-define-key '(input) "\C-v" 'evi-quoted-insert)
  1071.  
  1072. (evi-define-key '(input replace) "\C-c" 'keyboard-quit)
  1073. (evi-define-key '(input replace) "\e" 'evi-resume-continuation)
  1074.  
  1075. (evi-define-key '(insert) "\C-d" 'evi-backward-indent)
  1076. (evi-define-key '(insert) "\C-h" 'evi-insert-mode-delete-backward-char)
  1077. (evi-define-key '(insert) "\C-j" 'evi-newline)
  1078. (evi-define-key '(insert) "\C-m" 'evi-newline)
  1079. (evi-define-key '(insert) "\C-t" 'evi-forward-indent)
  1080. (evi-define-key '(insert) "\C-u" 'evi-insert-mode-kill-line)
  1081. (evi-define-key '(insert) "\C-w" 'evi-insert-mode-delete-backward-word)
  1082. (evi-define-key '(insert) "\C-x" 'evi-insert-mode-kill-line)
  1083. (evi-define-key '(insert) "\177" 'evi-insert-mode-delete-backward-char)
  1084.  
  1085. (evi-define-key '(replace) "\C-d" 'evi-replace-mode-backward-indent)
  1086. (evi-define-key '(replace) "\C-h" 'evi-replace-mode-delete-backward-char)
  1087. ;(evi-define-key (replace) "\C-t" 'evi-forward-indent)
  1088. (evi-define-key '(replace) "\C-u" 'evi-replace-mode-kill-line)
  1089. (evi-define-key '(replace) "\C-w" 'evi-replace-mode-delete-backward-word)
  1090. (evi-define-key '(replace) "\C-x" 'evi-replace-mode-kill-line)
  1091. (evi-define-key '(replace) "\177" 'evi-replace-mode-delete-backward-char)
  1092.  
  1093. (evi-define-key '(read-string ex)
  1094.                 "\C-h" 'evi-backward-char-maybe-abort)
  1095. (evi-define-key '(read-string-input ex-input)
  1096.                 "\C-h" 'evi-delete-backward-char-maybe-abort)
  1097. (evi-define-key '(read-string read-string-input ex ex-input)
  1098.                 "\C-j" 'evi-exit-minibuf)
  1099. (evi-define-key '(read-string read-string-input ex ex-input)
  1100.                 "\C-m" 'evi-exit-minibuf)
  1101. (evi-define-key '(read-string read-string-input ex ex-input)
  1102.                 "\e" 'evi-exit-minibuf)
  1103. (evi-define-key '(read-string ex)
  1104.                 "\177" 'evi-backward-char-maybe-abort)
  1105. (evi-define-key '(read-string-input ex-input)
  1106.                 "\177" 'evi-delete-backward-char-maybe-abort)
  1107.  
  1108. (evi-define-key '(ex-input) "\C-i" 'ex-complete)
  1109.  
  1110. (evi-define-key '(shell) "\C-m" 'evi-shell-send-input)
  1111.  
  1112. (defun evi-init-special-keys ()
  1113. (cond
  1114.   ((eq evi-emacs-version 'emacs19)
  1115.     (ex-map nil [left] "h")
  1116.     (ex-map nil [right] "l")
  1117.     (ex-map nil [up] "k")
  1118.     (ex-map nil [down] "j")
  1119.     ;(ex-map t [left] "\ei")
  1120.     ;(ex-map t [right] "x\edla")
  1121.     ;(ex-map t [up] "x\edlki")
  1122.     ;(ex-map t [down] "x\edlji")
  1123.  
  1124.     ;(defun evi-top-level-event (e)
  1125.     ;  (setq last-command-event e)
  1126.     ;  (evi-top-level))
  1127.  
  1128.     (defun evi-posn-buffer (position)
  1129.       "Return the buffer of the window in POSITION."
  1130.       (let ((window (posn-window position)))
  1131.     (and (integer-or-marker-p (posn-point position))
  1132.          window (window-buffer window))))
  1133.  
  1134.     (defun evi-mouse-drag-text (event handler)
  1135.       "\
  1136. Highlight text dragged by mouse; the event described by the highlight text
  1137. is passed to HANDLER, as is ARG (if provided)."
  1138.       (let ((frame (selected-frame))
  1139.         (start (posn-point (event-start event)))
  1140.         (overlay (make-overlay 1 1 (evi-posn-buffer (event-start event)))))
  1141.     (track-mouse
  1142.       (progn
  1143.       (overlay-put overlay 'face 'region)
  1144.       (while
  1145.           (cond
  1146.            ((not (listp (setq event (read-event)))))
  1147.            ((eq (car event) 'switch-frame)
  1148.         (if (eq (selected-frame) frame)
  1149.             (move-overlay overlay start start))
  1150.         t)
  1151.            ((mouse-movement-p event)
  1152.         (let ((end (posn-point (event-start event))))
  1153.           (if (and (integer-or-marker-p end)
  1154.                (eq (window-frame (posn-window
  1155.                           (event-start event)))
  1156.                    frame)
  1157.                (eq (evi-posn-buffer (event-start event))
  1158.                    (overlay-buffer overlay)))
  1159.               (move-overlay overlay start end)
  1160.             (move-overlay overlay start start)))
  1161.         t)))))
  1162.     (prog1
  1163.         (funcall handler event)
  1164.       (or unread-command-events (sit-for 9999))
  1165.       (delete-overlay overlay))))
  1166.  
  1167.     (defun evi-mouse-select-dragged-text (event)
  1168.       "Place the dragged region into the mouse selection.
  1169. Return the string in that region for insertion by the caller.
  1170. If EVENT is a click rather than a drag, invoke the appropriate binding.
  1171. This is intended for a button-down binding."
  1172.       (let ((string "")
  1173.         (window (posn-window (event-start event)))
  1174.         (region (list (posn-point (event-start event))
  1175.               (posn-point (event-end event)))))
  1176.     (if (eq (event-start event) (event-end event))
  1177. ;        (evi-mouse-set-point event)
  1178.         (setq unread-command-events
  1179.           (append unread-command-events (list event)))
  1180.       (if (eq (evi-posn-buffer (event-start event))
  1181.           (evi-posn-buffer (event-end event)))
  1182.           (save-excursion
  1183.         (save-window-excursion
  1184.           (let ((buffer (window-buffer (selected-window)))
  1185.             (point (point)))
  1186.             (select-window window)
  1187.             (setq string (apply 'buffer-substring region))
  1188.             (if (eq window-system 'x)
  1189.             (x-set-selection nil string)))))))
  1190.     string))
  1191.  
  1192.     (defun evi-mouse-copy-dragged-text (event)
  1193.       "Copy the dragged text to the mouse selection."
  1194.       (interactive "e")
  1195.       (evi-mouse-drag-text event 'evi-mouse-select-dragged-text))
  1196.  
  1197.     (defun evi-mouse-paste-selection (event)
  1198.       "Insert the X selection at the click point."
  1199.       (interactive "e")
  1200.       (if (eq window-system 'x)
  1201.       (progn (evi-push-macro (x-selection))
  1202.          (while evi-current-macro
  1203.            (evi-do-command)))))
  1204.  
  1205.     (defun evi-mouse-set-point (event)
  1206.       "Move point to the position clicked on with the mouse."
  1207.       (interactive "e")
  1208.       ;; Use event-end in case called from mouse-drag-region.
  1209.       ;; If EVENT is a click, event-end and event-start give same value.
  1210.       (let ((posn (event-end event)))
  1211.     (and (window-minibuffer-p (posn-window posn))
  1212.          (not (minibuffer-window-active-p (posn-window posn)))
  1213.          (error "Minibuffer window is not active"))
  1214.     (select-window (posn-window posn))
  1215.     (if (numberp (posn-point posn))
  1216.         (progn (goto-char (posn-point posn))
  1217.            (evi-fixup-cursor 'vertical)))))
  1218.  
  1219.     (define-key evi-top-level-map [down-mouse-1] 'evi-mouse-copy-dragged-text)
  1220.     (define-key evi-top-level-map [drag-mouse-1] 'evi-mouse-copy-dragged-text)
  1221.     (define-key evi-top-level-map [mouse-1] 'evi-mouse-set-point)
  1222.     (define-key evi-top-level-map [mouse-2] 'evi-mouse-paste-selection)
  1223.  
  1224. ; this would be better, but causes problems:
  1225. ;    (define-key evi-top-level-map [mouse-1] 'evi-top-level-event)
  1226. ;    (evi-define-key '(vi motion) [mouse-1] 'evi-mouse-set-point)
  1227.     )
  1228.  
  1229.   ((eq evi-emacs-version 'lucid19)
  1230.     ;; must find out how/if this interacts with the definition of ESC
  1231.     (let ((maps '(vi motion)))
  1232.       (evi-define-key maps 'down      'evi-next-line)
  1233.       (evi-define-key maps 'up      'evi-previous-line)
  1234.       (evi-define-key maps 'left      'evi-backward-char)
  1235.       (evi-define-key maps 'right      'evi-forward-char)
  1236.  
  1237.       (evi-define-key maps 'button1 'evi-mouse-track)
  1238.       (evi-define-key maps 'button2 'evi-x-set-point-and-insert-selection)
  1239.       (evi-define-key maps '(control button1) 'evi-mouse-track-insert)
  1240.       (evi-define-key maps '(control button2) 'evi-x-mouse-kill))
  1241.  
  1242.     (defun evi-mouse-track (event)
  1243.       (interactive "e")
  1244.       (mouse-track event)
  1245.       (evi-fixup-cursor 'vertical))
  1246.  
  1247.     (defun evi-mouse-track-insert (event)
  1248.       (interactive "e")
  1249.       (mouse-track-insert event)
  1250.       (evi-fixup-cursor 'vertical))
  1251.  
  1252.     (defun evi-x-mouse-kill (event)
  1253.       (interactive "e")
  1254.       (x-mouse-kill event)
  1255.       (evi-fixup-cursor 'vertical))
  1256.  
  1257.     (defun evi-x-set-point-and-insert-selection (event)
  1258.       (interactive "e")
  1259.       (x-set-point-and-insert-selection event)
  1260.       (evi-fixup-cursor 'vertical)))
  1261.   (t
  1262.     ;; else version 18
  1263.     (define-key function-keymap "l" 'evi-backward-char)
  1264.     (define-key function-keymap "r" 'evi-forward-char)
  1265.     (define-key function-keymap "u" 'evi-previous-line)
  1266.     (define-key function-keymap "d" 'evi-next-line)))
  1267. )
  1268.  
  1269. ;; Mode line
  1270.  
  1271. (defvar evi-mode-line-format " Evi:%-6s")
  1272.  
  1273. ;; string used to identify three modes
  1274. (defvar evi-command-mode-string  "Vi")
  1275. (defvar evi-insert-mode-string  "Insert")
  1276. (defvar evi-replace-mode-string "Replce")
  1277.  
  1278. (defun evi-in-mode-line-p (var)
  1279.   (if (listp mode-line-buffer-identification)
  1280.       (memq var mode-line-buffer-identification)
  1281.     nil))
  1282.  
  1283. (defun evi-install-in-mode-line (var)
  1284.   (or (evi-in-mode-line-p var)
  1285.       (setq mode-line-buffer-identification
  1286.         (if (listp mode-line-buffer-identification)
  1287.         (append mode-line-buffer-identification (list var))
  1288.           (cons mode-line-buffer-identification (list var))))))
  1289.  
  1290. (defun evi-deinstall-from-mode-line (var)
  1291.   (if (evi-in-mode-line-p var)
  1292.       (setq mode-line-buffer-identification
  1293.         (evi-filter (function (lambda (mode-var) (not (eq var mode-var))))
  1294.             mode-line-buffer-identification))))
  1295.  
  1296. (defun evi-change-mode-id (string)
  1297.   "Change Evi's mode identification string to STRING."
  1298.   (setq evi-mode-string (format evi-mode-line-format string)))
  1299.  
  1300. (defun evi-refresh-mode-line ()
  1301.   "Redraw mode line."
  1302.   (set-buffer-modified-p (buffer-modified-p)))
  1303.  
  1304. ;; Command macros
  1305.  
  1306. (defun evi-parameterized-macro ()
  1307.   (interactive)
  1308.   (evi-extend-continuation 'evi-parameterized-macro-after)
  1309.   (evi-read-string "\("))
  1310.  
  1311. (defun evi-parameterized-macro-after ()
  1312.   (evi-push-macro evi-minibuf-contents
  1313.           'evi-parameterized-macro-after-after
  1314.           evi-register-parameter evi-prefix-count-parameter
  1315.           evi-keymap-list)
  1316.   (setq evi-register-parameter evi-register-spec
  1317.     evi-register-spec nil
  1318.     evi-prefix-count-parameter evi-prefix-count
  1319.     evi-prefix-count nil
  1320.     evi-keymap-list (cons evi-param-map evi-keymap-list)))
  1321.  
  1322. (defun evi-parameterized-macro-after-after (reg-spec count keymap-list)
  1323.   (setq evi-register-parameter reg-spec
  1324.     evi-prefix-count-parameter count
  1325.     evi-keymap-list keymap-list))
  1326.  
  1327. (defvar evi-internal-macro-keys (make-string 32 0))
  1328.  
  1329. (defun evi-internal-macro (macro)
  1330.   (evi-push-macro macro
  1331.           'evi-internal-after evi-parameterized-macro evi-remap
  1332.           evi-register-spec evi-prefix-count
  1333.           evi-command-keys evi-command-keys-index)
  1334.   (setq evi-register-parameter evi-register-spec
  1335.     evi-register-spec nil
  1336.     evi-prefix-count-parameter evi-prefix-count
  1337.     evi-prefix-count nil
  1338.     evi-parameterized-macro t
  1339.     evi-remap nil
  1340.     evi-command-keys evi-internal-macro-keys
  1341.     evi-command-keys-index 0))
  1342.  
  1343. (defun evi-internal-after (param-flag remap-flag reg count command-keys index)
  1344.   (setq evi-parameterized-macro param-flag
  1345.     evi-remap remap-flag
  1346.     evi-register-spec reg
  1347.     evi-prefix-count count
  1348.     evi-command-keys command-keys
  1349.     evi-command-keys-index index)
  1350.   (evi-save-command-keys))
  1351.  
  1352. (defun evi-register-macro (char &optional count)
  1353.   (interactive (evi-character-arg))
  1354.   (let* ((evi-last-command-keys nil)
  1355.      (register-number (evi-register-number char))
  1356.      (macro (evi-register-text (aref evi-registers register-number))))
  1357.     (setq evi-last-macro-register register-number)
  1358.     (evi-push-macro macro)
  1359.     (evi-get-command)))
  1360.  
  1361. ; ZZ
  1362. (defvar evi-minibuf-prompt nil)
  1363. (defvar evi-minibuf nil)
  1364. (defvar evi-minibuf-prev nil)
  1365. (defvar evi-minibuf-user-window nil)
  1366.  
  1367. ; needn't mess with the display if we're just in a macro...
  1368.  
  1369. (defun evi-read-string (prompt &optional initial vi-map input-map)
  1370.   (if evi-in-minibuf
  1371.       (evi-error "Can't use minibuffer inside minibuffer"))
  1372.   ;; this whole thing seems unduly complicated...
  1373.   (set-buffer (get-buffer-create (concat " *evi-" prompt "-Minibuf*")))
  1374.   ;; we want undo information anyway (despite the space in the buffer name)
  1375.   (if (eq buffer-undo-list t)
  1376.       (setq buffer-undo-list nil))
  1377.   (evi)
  1378.   (evi-set-continuation 'evi-read-string-after)
  1379.   (evi-mark-continuation)
  1380.   (evi-push-continuation 'evi-standard-continuation)
  1381.   (setq evi-minibuf-prompt prompt
  1382.     evi-minibuf (current-buffer)
  1383.     evi-minibuf-prev (window-buffer (minibuffer-window))
  1384.     evi-minibuf-user-window (selected-window))
  1385.   ;; doesn't seem to work (or evi-current-macro ...)
  1386.   (set-window-buffer (minibuffer-window) (current-buffer))
  1387.   (select-window (minibuffer-window))
  1388.   (setq evi-in-minibuf t)
  1389.   (goto-char (point-max))
  1390.   (if (eq evi-emacs-version 'emacs18)
  1391.       (display-buffer (current-buffer))
  1392.     (message nil))
  1393.   (insert prompt)
  1394.   ;;ZZ would be best if insert point could be set here
  1395.   (if initial
  1396.       (insert initial))
  1397.   (setq evi-buffer-local-vi-map (or vi-map evi-read-string-map)
  1398.     evi-buffer-local-input-map (or input-map evi-read-string-input-map))
  1399.   (evi-insert))
  1400.  
  1401. (defun evi-exit-minibuf-window ()
  1402.   (goto-char (1- (point-max)))
  1403.   (beginning-of-line)
  1404.   ;; ZZ - kludge-check for "[{" and escape the `['
  1405.   (if (looking-at (concat (if (= (aref evi-minibuf-prompt 0) ?\[) "\\")
  1406.               evi-minibuf-prompt " *$"))
  1407.       (delete-region (point) (point-max))
  1408.     (goto-char (point-max)))
  1409.   (set-buffer evi-minibuf)
  1410.   (set-window-buffer (minibuffer-window) evi-minibuf-prev)
  1411.   (select-window evi-minibuf-user-window)
  1412.   (setq evi-in-minibuf nil))
  1413.  
  1414. (defun evi-read-string-after ()
  1415.   (setq evi-minibuf-contents
  1416.     (buffer-substring (+ (point) (length evi-minibuf-prompt))
  1417.               (progn (end-of-line) (point))))
  1418.   (evi-exit-minibuf-window)
  1419.   (evi-pop-continuation))
  1420.  
  1421. (defun evi-switch-to-vi ()
  1422.   (cond ((eq evi-mode 'insert)
  1423.       (evi-exit-insert))
  1424.     ((eq evi-mode 'replace)
  1425.       (evi-exit-replace))
  1426.     ((eq evi-mode 'change)
  1427.       (evi-exit-replace))))
  1428.  
  1429. (defun evi-exit-minibuf ()
  1430.   (interactive)
  1431.   (evi-switch-to-vi)
  1432.   (beginning-of-line)
  1433.   (evi-sit-for 0)
  1434.   (evi-unwind-continuations))
  1435.  
  1436. (defun evi-abort-minibuf ()
  1437.   (evi-exit-minibuf-window)
  1438.   (evi-discard-continuations)
  1439.   (evi-push-continuation 'evi-standard-continuation))
  1440.  
  1441. (cond ((eq evi-emacs-version 'lucid19)
  1442.     (defun evi-read-char ()
  1443.       (if evi-unread-command-char
  1444.           (prog1 evi-unread-command-char
  1445.         (setq evi-unread-command-char nil))
  1446.         (or (evi-read-macro)
  1447.         (let ((event (allocate-event)))
  1448.           (setq evi-timed-out nil)
  1449.           (while (progn
  1450.                (next-event event)
  1451.                (not (key-press-event-p event)))
  1452.             (dispatch-event event))
  1453.           (or (event-to-character event t t)
  1454.               (event-key event)))))))
  1455.       ((eq evi-emacs-version 'emacs19)
  1456.     (defun evi-read-char ()
  1457.       (if evi-unread-command-char
  1458.           (prog1 evi-unread-command-char
  1459.         (setq evi-unread-command-char nil))
  1460.         (or (evi-read-macro)
  1461.         (let ((ev (read-event)))
  1462.           (setq evi-timed-out nil)
  1463.           (or (and (symbolp ev)
  1464.                (get (car (get ev 'event-symbol-element-mask))
  1465.                 'ascii-character))
  1466.               ev))))))
  1467.       (t
  1468.     (defun evi-read-char ()
  1469.       (if evi-unread-command-char
  1470.           (prog1 evi-unread-command-char
  1471.         (setq evi-unread-command-char nil))
  1472.         (or (evi-read-macro)
  1473.         (progn (setq evi-timed-out nil)
  1474.                (read-char)))))))
  1475.  
  1476. (defun evi-push-macro (macro &optional after &rest args)
  1477.   (setq evi-macro-stack (cons (cons (cons evi-current-macro
  1478.                       evi-current-macro-index)
  1479.                     (cons after args))
  1480.                   evi-macro-stack)
  1481.     evi-current-macro macro
  1482.     evi-current-macro-index 0))
  1483.  
  1484. (defun evi-pop-macro ()
  1485.   (let ((after (cdr (car evi-macro-stack))))
  1486.     (setq evi-current-macro (car (car (car evi-macro-stack)))
  1487.       evi-current-macro-index (cdr (car (car evi-macro-stack)))
  1488.       evi-macro-stack (cdr evi-macro-stack))
  1489.     (if (car after)
  1490.     (apply (car after) (cdr after)))))
  1491.  
  1492. (defun evi-discard-macros ()
  1493.   (setq evi-current-macro nil
  1494.     evi-macro-stack nil))
  1495.  
  1496. (defun evi-read-macro ()
  1497.   (while (and evi-current-macro
  1498.           (= evi-current-macro-index (length evi-current-macro)))
  1499.     (evi-pop-macro))
  1500.   (if evi-current-macro
  1501.       (prog1 (aref evi-current-macro evi-current-macro-index)
  1502.     (setq evi-current-macro-index (1+ evi-current-macro-index)))))
  1503.  
  1504. (defun evi-sit-for (count)
  1505.   (cond (evi-unread-command-char nil)
  1506.     (evi-current-macro
  1507.       (if (or (cdr evi-macro-stack)
  1508.           (/= evi-current-macro-index (length evi-current-macro)))
  1509.           nil
  1510.         t))
  1511.     (t (sit-for count))))
  1512.  
  1513. (defun evi-register-parameter ()
  1514.   (interactive)
  1515.   (setq evi-register-spec evi-register-parameter)
  1516.   (evi-push-continuation 'evi-prompt))
  1517.  
  1518. (defun evi-prefix-count-parameter ()
  1519.   (interactive)
  1520.   (setq evi-prefix-count evi-prefix-count-parameter)
  1521.   (evi-push-continuation 'evi-prompt))
  1522.  
  1523. ;; Errors
  1524.  
  1525. (defun evi-error (&rest args)
  1526.   (throw 'abort (apply 'format args)))
  1527.  
  1528. (defun evi-warning (&rest args)
  1529.   (if evi-interactive
  1530.       (progn
  1531.     (evi-discard-continuations)
  1532.     (evi-push-continuation 'evi-standard-continuation)
  1533.     (throw 'abort (apply 'format args)))
  1534.     (princ (apply 'format args))
  1535.     (terpri)))
  1536.  
  1537. ;; Continuations
  1538.  
  1539. (defvar evi-debug-cont nil)
  1540.  
  1541. ; ZZ need this be buffer specific??  yes!!!
  1542. (evi-defbuffervar evi-continuation-stack nil
  1543.   "The continuation stack.")
  1544.  
  1545. (defun evi-set-continuation (func &rest args)
  1546.   (setq evi-continuation-stack (cons (cons func args) nil)))
  1547.  
  1548. (defun evi-push-continuation (func &rest args)
  1549.   (setq evi-continuation-stack (cons (cons func args) evi-continuation-stack))
  1550.   (if evi-debug-cont (evi-db (concat "{PU:" (prin1-to-string evi-continuation-stack) "}\n")))
  1551.   )
  1552.  
  1553. (defun evi-extend-continuation (func &rest args)
  1554.   (setq evi-continuation-stack
  1555.     (if (eq (car evi-continuation-stack) 'suspend)
  1556.         (cons (cons func args) evi-continuation-stack)
  1557.       (cons (list 'progn (cons func args) (car evi-continuation-stack))
  1558.         (cdr evi-continuation-stack))))
  1559.   (if evi-debug-cont (evi-db (concat "{EX:" (prin1-to-string evi-continuation-stack) "}\n")))
  1560.   )
  1561.  
  1562. (defun evi-suspend-continuation ()
  1563.   (setq evi-continuation-stack (cons 'suspend evi-continuation-stack))
  1564.   (if evi-debug-cont (evi-db (concat "{SU:" (prin1-to-string evi-continuation-stack) "}\n")))
  1565.   )
  1566.  
  1567. (defun evi-resume-continuation ()
  1568.   (interactive)
  1569.   (setq evi-continuation-stack (cdr evi-continuation-stack))
  1570.   (if evi-debug-cont (evi-db (concat "{RE:" (prin1-to-string evi-continuation-stack) "}\n")))
  1571.   )
  1572.  
  1573. (defun evi-mark-continuation ()
  1574.   (setq evi-continuation-stack (cons 'mark evi-continuation-stack))
  1575.   (if evi-debug-cont (evi-db (concat "{MA:" (prin1-to-string evi-continuation-stack) "}\n")))
  1576.   )
  1577.  
  1578. (defun evi-unwind-continuations ()
  1579.   (while (not (eq (car evi-continuation-stack) 'mark))
  1580.     (or evi-continuation-stack
  1581.     (evi-error "No continuation mark found!"))
  1582.     (setq evi-continuation-stack (cdr evi-continuation-stack)))
  1583.   (setq evi-continuation-stack (cdr evi-continuation-stack)))
  1584.  
  1585. (defun evi-reset-continuations ()
  1586.   (while (and evi-continuation-stack
  1587.           (not (eq (car evi-continuation-stack) 'mark)))
  1588.     (setq evi-continuation-stack (cdr evi-continuation-stack))))
  1589.  
  1590. (defun evi-pop-continuation ()
  1591.   (if evi-debug-cont (evi-db (concat "{PO:" (prin1-to-string evi-continuation-stack) "}\n")))
  1592.   (or (eq (car evi-continuation-stack) 'suspend)
  1593.       (eval (prog1 (car evi-continuation-stack)
  1594.            (setq evi-continuation-stack
  1595.              (cdr evi-continuation-stack))))))
  1596.  
  1597. (defun evi-discard-continuation ()
  1598.   (if evi-debug-cont (evi-db (concat "{DI:" (prin1-to-string evi-continuation-stack) "}\n")))
  1599.   (setq evi-continuation-stack (cdr evi-continuation-stack)))
  1600.  
  1601. (defun evi-discard-continuations ()
  1602.   (if evi-debug-cont (evi-db (concat "{DS:" (prin1-to-string evi-continuation-stack) "}\n")))
  1603.   (while (and evi-continuation-stack
  1604.           (not (eq (car evi-continuation-stack) 'suspend)))
  1605.     (setq evi-continuation-stack (cdr evi-continuation-stack)))
  1606.   (if evi-continuation-stack
  1607.       (setq evi-continuation-stack (cdr evi-continuation-stack))))
  1608.  
  1609. ;; Top level
  1610.  
  1611. (defun evi-top-level ()
  1612.   (interactive)
  1613.   ;; ZZ
  1614.   (if (null evi-continuation-stack)
  1615.       (progn (message "Glitch!")
  1616.          (evi-push-continuation 'evi-standard-continuation)))
  1617.   (if (eq evi-emacs-version 'emacs19)
  1618.       (setq evi-unread-command-char last-command-event)
  1619.     (setq evi-unread-command-char last-command-char))
  1620.   (evi-do-command)
  1621.   (while evi-current-macro
  1622.     (evi-do-command)))
  1623.  
  1624. (defvar evi-delayed-buffer-change-request nil)
  1625.  
  1626. ; ZZ needs to be initialized at beginning of emulation in any given buffer
  1627. (defun evi-standard-continuation ()
  1628.   ;; do some preemptive finishing up of macros to get the execution time
  1629.   ;; of any `macro-afters' to happen at the right time
  1630.   (while (and evi-current-macro
  1631.           (= evi-current-macro-index (length evi-current-macro)))
  1632.     (evi-pop-macro))
  1633.   (setq evi-prompted nil
  1634.     evi-prefix-count nil
  1635.     evi-register-spec nil)
  1636.   (evi-erase-keys)
  1637.   (evi-push-continuation 'evi-standard-continuation)
  1638.   (if evi-delayed-buffer-change-request
  1639.       (progn
  1640.     (if (eq (car evi-delayed-buffer-change-request) 'other)
  1641.         (switch-to-buffer-other-window
  1642.          (car (cdr evi-delayed-buffer-change-request)))
  1643.       (switch-to-buffer (car (cdr evi-delayed-buffer-change-request))))
  1644.     (eval (cdr (cdr evi-delayed-buffer-change-request)))
  1645.     (setq evi-delayed-buffer-change-request nil))))
  1646.  
  1647. (defun evi-prompt ()
  1648.   (and (not evi-in-minibuf) (evi-sit-for 1)
  1649.        (progn (message "%s -" (evi-prompt-keys-description))
  1650.           (setq evi-prompted t))))
  1651.  
  1652. (defun evi-do-command ()
  1653.   (let ((message (if evi-debug
  1654.              (catch 'abort
  1655.                (evi-get-command)
  1656.                (evi-pop-continuation)
  1657.                nil)
  1658.            (condition-case code
  1659.                (catch 'abort
  1660.              (evi-get-command)
  1661.              (evi-pop-continuation)
  1662.              nil)
  1663.              (error
  1664.                (evi-reset-top-level)
  1665.                (signal (car code) (cdr code)))
  1666.              (quit
  1667.                (evi-reset-top-level)
  1668.                (signal (car code) (cdr code)))))))
  1669.     (if message
  1670.     (progn (if (eq message t)
  1671.            nil
  1672.          (evi-soft-reset)
  1673.          (if evi-error-bell (beep))
  1674.          (or evi-in-minibuf
  1675.              (message message)))
  1676.            (evi-fixup-cursor 'horizontal)))))
  1677.  
  1678. (defun evi-reset-top-level ()
  1679. ;  may need code to bail out of a `change' gracefully (cleaning up the $)?
  1680.   (if evi-in-minibuf
  1681.       (evi-abort-minibuf))
  1682.   (setq evi-mode 'vi
  1683.     evi-context nil
  1684.     evi-prefix-count nil
  1685.     evi-prefix-count-multiplier nil
  1686.     evi-register-spec nil
  1687.     evi-prompted nil
  1688.     evi-overstruck-char nil
  1689.     evi-keymap-list evi-vi-keymap-list)
  1690.   (evi-change-mode-id evi-command-mode-string)
  1691.   (evi-refresh-mode-line)
  1692.   (evi-erase-keys)
  1693.   (evi-discard-macros)
  1694.   (evi-set-continuation 'evi-standard-continuation)
  1695.   (evi-fixup-cursor 'horizontal))
  1696.  
  1697. ; ZZ will this work properly if in the middle of an internal macro?
  1698. (defun evi-soft-reset ()
  1699.   (setq evi-mode 'vi
  1700.     evi-context nil
  1701.     evi-prefix-count nil
  1702.     evi-prefix-count-multiplier nil
  1703.     evi-register-spec nil
  1704.     evi-prompted nil
  1705.     evi-overstruck-char nil
  1706.     evi-keymap-list evi-vi-keymap-list)
  1707.   (or evi-in-minibuf
  1708.       (progn (evi-change-mode-id evi-command-mode-string)
  1709.          (evi-refresh-mode-line)))
  1710.   (evi-erase-keys)
  1711.   (evi-reset-continuations)
  1712.   (evi-push-continuation 'evi-standard-continuation)
  1713.   (evi-fixup-cursor 'horizontal))
  1714.  
  1715. (defun evi-emacs-command ()
  1716.   (interactive)
  1717.   (evi-unread-command-char last-command-char)
  1718.   (let ((evi-keymap-list
  1719.      (if (boundp 'minor-mode-map-alist)
  1720.          (list (cons 'minor nil)
  1721.            (cons 'emacs (cons 'local nil))
  1722.            (cons 'emacs (cons 'global nil)))
  1723.        (if evi-emacs-local-map
  1724.            (list evi-emacs-local-map (current-global-map))
  1725.          (list (current-global-map))))))
  1726.     (if evi-global-directory
  1727.     (setq default-directory (evi-current-directory)))
  1728.     (evi-get-command)))
  1729.  
  1730. (defun evi-db (string)
  1731.   (let ((buf (current-buffer))
  1732.     (dbuf (get-buffer-create "*debug*")))
  1733.     (or (eq buf dbuf)
  1734.     (progn
  1735.       (set-buffer dbuf)
  1736.       (insert string)
  1737.       (set-buffer buf)))))
  1738.  
  1739. ;; this is one stinker of a function that really needs to be re-written!!
  1740. ;; it is hack-ridden and fugly - it should be factored into:
  1741. ;;     - evi-lookup-in-keymaps (the `enumerate-condition' loop)
  1742. ;;     - evi-lookup-key (the hairy `cond' at the beginning of above loop)
  1743. ;;     - evi-process-keydef (the hairy `while' after it)
  1744. ;; however that would need to be done carefully since this is the very
  1745. ;; heart of evi and needs to be efficient
  1746. (defun evi-get-command ()
  1747.   (let* ((inhibit-quit t)
  1748.      (char (evi-read-command-char))
  1749.      (keys (if (integerp char) (char-to-string char) (vector char)))
  1750.      (keydef))
  1751.     (setq evi-timed-out nil)
  1752.     (evi-enumerate-condition keymap evi-keymap-list
  1753.       (progn
  1754.     (cond
  1755.       ((keymapp keymap)
  1756.         (setq keydef (lookup-key keymap keys)))
  1757.       ((symbolp keymap)
  1758.         (setq keydef (lookup-key (symbol-value keymap) keys)))
  1759.       ;; otherwise, we have a conditional keymap - the car is an
  1760.       ;; identifying symbol and the cdr is the keymap
  1761.       ((eq (car keymap) 'param)
  1762.         (if evi-parameterized-macro
  1763.         (setq keydef (lookup-key (cdr keymap) keys))
  1764.           (setq keydef nil)))
  1765.       ((eq (car keymap) 'map)
  1766.         (if (or evi-remap (not evi-current-macro))
  1767.         (setq keydef (lookup-key (cdr keymap) keys))
  1768.           (setq keydef nil)))
  1769.       ((eq (car keymap) 'minor)
  1770.         (let* ((maps (evi-filter (function (lambda (m) (and (not (eq (car m) 'evi-enabled)) (symbol-value (car m))))) minor-mode-map-alist))
  1771.            (maps2 (mapcar (function (lambda (m) (cons (if (eq evi-mode 'vi) 'cond-emacs 'emacs) (cons (cdr m) nil)))) maps)))
  1772.           ;; way cheating - insert all the minor mode maps before the
  1773.           ;; rest of the keymap list - the extra cons is because a
  1774.           ;; (setq list (cdr list)) will be done at the end of the loop
  1775.           (setq list (cons nil (append maps2 (cdr list)))
  1776.             keydef nil)))
  1777.       ;; otherwise, we have an emacs keymap
  1778.       ;; the car is either 'emacs, or 'cond-emacs - 'cond-emacs
  1779.       ;; means only use if enable-emacs-commands is set
  1780.       ;; policy: you can't reach an emacs command by timeout
  1781.       ((and (or evi-enable-emacs-commands (eq (car keymap) 'emacs))
  1782.         (not evi-timed-out))
  1783.         ;; we now have a pair where the car indicates local or global
  1784.         ;; (or minor-mode-map, if neither)
  1785.         ;; and the cdr is a list of chars that we want to pass-thru
  1786.         ;; this keymap.  also we map our meta-prefix to emacs' meta-prefix
  1787.         (if (memq (aref keys 0) (cdr (cdr keymap)))
  1788.         (setq keydef nil)
  1789.           (let ((map (cond ((eq (car (cdr keymap)) 'global)
  1790.                  (current-global-map))
  1791.                    ((eq (car (cdr keymap)) 'local)
  1792.                  (current-local-map))
  1793.                    (t
  1794.                  (car (cdr keymap))))))
  1795.         (setq keydef
  1796.           (if map
  1797.               (lookup-key map
  1798.             ;; must use `eq' because key may be a symbol
  1799.             (if (eq (aref keys 0) evi-meta-prefix-char)
  1800.                 (if (eq evi-emacs-version 'lucid19)
  1801.                 (if (= (length keys) 1)
  1802.                     (setq char (+ (evi-read-command-char)
  1803.                           128)
  1804.                       keys (char-to-string char))
  1805.                   (concat
  1806.                    (char-to-string (+ (aref keys 1) 128))
  1807.                    (substring keys 2)))
  1808.                   (concat
  1809.                 (char-to-string evi-emacs-meta-prefix-char)
  1810.                 (substring keys 1)))
  1811.               keys)))))))
  1812.       (t
  1813.         (setq keydef nil)))
  1814.     (while
  1815.       (cond ((keymapp keydef)
  1816.           ;; if it times out, it can be a shorter (or equal) command
  1817.           ;; string (than we've seen so far), but *not* a longer one.
  1818.           ;; there's no explicit code *here* (other than setting the
  1819.           ;; timed-out flag) to handle this situation, because it can't
  1820.           ;; seem to arise (the only keymap w/ timeouts in it is the
  1821.           ;; `map' keymap) - we use the flag to avoid following up on
  1822.           ;; a `prefix' key sequence (see below)
  1823.           (if (and evi-timeout (evi-sit-for 1))
  1824.               (setq evi-timed-out t
  1825.                 keydef nil)
  1826.             (setq char (evi-read-command-char)
  1827.               keys (concat keys (char-to-string char))
  1828.               keydef (lookup-key keydef (char-to-string char))))
  1829.           t)
  1830.         ((stringp keydef)
  1831.           (if evi-prompted (message ""))
  1832.           (setq last-command-char char
  1833.             last-command-event char
  1834.             evi-prompted nil)
  1835.           (evi-push-macro
  1836.             keydef
  1837.             (function (lambda (lck)
  1838.                 (setq evi-last-command-keys lck)))
  1839.             evi-last-command-keys)
  1840.           (evi-push-continuation (function (lambda ())))
  1841.           nil)
  1842.         ((commandp keydef)
  1843.           (if evi-prompted (message ""))
  1844.           (setq last-command-char char
  1845.             last-command-event char
  1846.             evi-prompted nil
  1847.             quit-flag nil
  1848.             inhibit-quit nil)
  1849.           (call-interactively keydef)
  1850.           nil)
  1851.         ((and (consp keydef) (eq (car keydef) 'prefix)
  1852.               (not evi-timed-out))
  1853.           (evi-prompt)
  1854.           (setq char (evi-read-command-char)
  1855.             keys (concat keys (char-to-string char))
  1856.             keydef (lookup-key (cdr keydef)
  1857.                        (char-to-string char))
  1858.             list nil)
  1859.           t)
  1860.         ((numberp keydef)
  1861.           ;; the current keystring is `too long' - i.e. a prefix of
  1862.           ;; the keystring matches some prefix in the current keymap,
  1863.           ;; but is longer than any keystring with that prefix in
  1864.           ;; the current keymap - solution: retry with the matching
  1865.           ;; prefix, and push the rest into a macro
  1866.           (evi-lose-key (- (length keys) keydef))
  1867.           (evi-push-macro (substring keys keydef))
  1868.           (setq char (aref keys (1- keydef))
  1869.             keys (substring keys 0 keydef)
  1870.             keydef nil
  1871.             ;; way gauche - add filler so that we'll stay at
  1872.             ;; the same spot in the keymap list
  1873.             list (cons nil list)))
  1874.         (t
  1875.           (setq keydef nil))))
  1876.     (not keydef)))
  1877.     (or keydef (progn (if evi-error-bell (beep))
  1878.               ;; ZZ!
  1879.               ;; (if (= char ?\C-z) (kill-emacs))
  1880.               (evi-error "Unknown command `%s'"
  1881.                  (evi-keys-description))))))
  1882.  
  1883. (defun evi-read-command-char ()
  1884.   (let ((char (evi-read-char)))
  1885.     (or evi-current-macro
  1886.     ;; ZZ punt for now...
  1887.     (if (integerp char)
  1888.         (evi-add-key char)
  1889.       (evi-add-key ?#)))
  1890.     char))
  1891.  
  1892. (defun evi-unread-command-char (char)
  1893.   (setq evi-unread-command-char char)
  1894.   (evi-lose-key))
  1895.  
  1896. ;; Interactive args
  1897.  
  1898. (defun evi-count-arg ()
  1899.   (list evi-prefix-count))
  1900.  
  1901. (defun evi-register-args ()
  1902.   (list (car evi-register-spec) (cdr evi-register-spec) evi-prefix-count))
  1903.  
  1904. (defun evi-character-arg ()
  1905.   (list (evi-read-command-char) evi-prefix-count))
  1906.  
  1907. (defun evi-context-arg ()
  1908.   (list evi-context))
  1909.  
  1910. ;; Initializing
  1911.  
  1912. (defun evi-initialize ()
  1913.   (setq evi-initialized t
  1914.     evi-directory-stack (list default-directory)
  1915.     evi-emacs-meta-prefix-char meta-prefix-char)
  1916.   (evi-init-special-keys)
  1917.   (if (eq evi-emacs-version 'emacs18)
  1918.       (let ((temp-buffer-show-hook 'evi-startup-show-hook))
  1919.     (with-output-to-temp-buffer "*Startup*"
  1920.       (evi-customize)))
  1921.     (let ((temp-buffer-show-function 'evi-startup-show-hook))
  1922.       (with-output-to-temp-buffer "*Startup*"
  1923.     (evi-customize))))
  1924.   (if (boundp 'minor-mode-map-alist)
  1925.       (setq minor-mode-map-alist
  1926.         (cons (cons 'evi-enabled evi-top-level-map) minor-mode-map-alist)))
  1927.   (or evi-meta-prefix-char
  1928.       (setq evi-meta-prefix-char evi-emacs-meta-prefix-char))
  1929.   (evi-welcome-message))
  1930.  
  1931. (defun evi-startup-show-hook (buf)
  1932.   (let ((curbuf (current-buffer)))
  1933.     (set-buffer buf)
  1934.     (if (not (and (bobp) (eobp)))
  1935.     (progn
  1936.       (goto-char (point-min))
  1937.       (insert "The following problems were found at startup:\n")
  1938.       (display-buffer buf)
  1939.       (message "Use `z1=' to show only `%s'" (buffer-name curbuf))))
  1940.     (set-buffer curbuf)))
  1941.  
  1942. (defun evi-customize ()
  1943.   ; mimic emacs startup behaviour:
  1944.   ;   if su'd, use effective login name to find startup files (??)
  1945.   (let* ((user-name (user-login-name))
  1946.      (home (if (string= user-name (user-real-login-name))
  1947.          "~"
  1948.          (concat "~" user-name))))
  1949.     (if (file-readable-p "~/.evirc") (load-file (concat home "/.evirc")))
  1950.     (if (file-readable-p ".evirc")
  1951.     (load-file ".evirc"))
  1952.     (let* ((evi-interactive nil)
  1953.        (source)
  1954.        (message (catch 'abort
  1955.               (or evi-suppress-ex-startup
  1956.               (progn
  1957.                 (setq source "~/.exrc")
  1958.                 (evi-do-ex-command-file (concat home "/.exrc"))))
  1959.               (setq source "~/.exrc.evi")
  1960.               (evi-do-ex-command-file (concat home "/.exrc.evi"))
  1961.               (or evi-suppress-ex-startup
  1962.               (progn
  1963.                 (if evi-local-exrc
  1964.                 (progn (setq source ".exrc")
  1965.                        (evi-do-ex-command-file ".exrc")))
  1966.                 (setq source "EXINIT")
  1967.                 (let ((exinit (getenv "EXINIT")))
  1968.                   (if exinit
  1969.                   (evi-do-ex-command-string exinit)))))
  1970.               (if evi-local-exrc
  1971.               (progn (setq source ".exrc.evi")
  1972.                  (evi-do-ex-command-file ".exrc.evi")))
  1973.               (setq source "EVIINIT")
  1974.               (let ((exinit (getenv "EVIINIT")))
  1975.             (if exinit
  1976.                 (evi-do-ex-command-string exinit)))
  1977.               nil)))
  1978.       (if message
  1979.       (progn
  1980.         (beep)
  1981.         (if (not (y-or-n-p (concat "Error in " source
  1982.                  (if (eq message t) "" (concat ": " message))
  1983.                  ". Continue? ")))
  1984.         (ex-quit nil)))))))
  1985.  
  1986. (defun evi-welcome-message ()
  1987.   (and (not evi-inhibit-startup-message) (not noninteractive)
  1988.        (eq (current-buffer) (get-buffer "*scratch*"))
  1989.        (not (input-pending-p))
  1990.        (progn
  1991.      (insert evi-version ".  " evi-copyright ".
  1992.  
  1993. Evi is an enhanced emulator for Vi that runs in an emacs environment.
  1994. If you are familiar with vi, you should have very few problems using Evi.
  1995. By default, Evi is setup to emulate vi as closely as it can; however,
  1996. there are a number of new commands (mostly `:' commands) that support
  1997. the multiple window/multiple buffer environment that emacs provides.
  1998. In addition, file/buffer/command/etc completion is supported for `:'
  1999. commands (use `TAB' to complete).
  2000.  
  2001. Type `Q' to exit Evi (back to emacs).  Type `ZZ' to save *all* modified
  2002. files and exit emacs.  Type `:w' to save the current file, and `:W' to
  2003. save all modified files.  Type `:q' to quit "
  2004.          (cond ((eq evi-emacs-version 'emacs18)
  2005.              "emacs.")
  2006.                ((eq evi-emacs-version 'emacs19)
  2007.              "the current frame, and
  2008. quit emacs if only one frame exists.")
  2009.                ((eq evi-emacs-version 'lucid19)
  2010.              "the current screen, and
  2011. quit emacs if only one screen exists.")) "
  2012.  
  2013. You may be interested in the following enhancements, which are disabled
  2014. by default: using emacs commands, command line editing, backslash escapes
  2015. (such as `\\n') and disabling this message(!).  For more information, consult
  2016. the Evi manual (in the files `evi.info' or `evi.tex').  Hopefully this is
  2017. available by using `M-x info' and selecting the `Evi' menu item.  If
  2018. necessary, consult your nearest emacs guru for advice.")
  2019.      (set-buffer-modified-p nil)
  2020.      (sit-for 120)
  2021.      (save-excursion
  2022.        ;; evidently we must worry about having been switched to another
  2023.        ;; buffer while waiting...
  2024.        (set-buffer (get-buffer "*scratch*"))
  2025.        (erase-buffer)
  2026.        (set-buffer-modified-p nil))
  2027.      (setq inhibit-startup-message t))))
  2028.  
  2029. ;; Startup & Shutdown
  2030.  
  2031. ;;;###autoload
  2032. (defun evi ()
  2033.   "Start vi emulation in this buffer."
  2034.   (interactive)
  2035.   (or evi-enabled
  2036.       (progn
  2037.     (or evi-initialized
  2038.         (evi-initialize))
  2039.     (setq evi-emacs-local-map (current-local-map))
  2040.     (evi-install-in-mode-line 'evi-mode-string)
  2041. ;;; This is no good.  This changes the quit character for all buffers
  2042. ;;; on this device, which is probably not wanted.    
  2043. ;    (if (eq evi-emacs-version 'lucid19)
  2044. ;        (let ((curinp (current-input-mode)))
  2045. ;          (set-input-mode (nth 0 curinp)
  2046. ;                  (nth 1 curinp)
  2047. ;                  (nth 2 curinp)
  2048. ;                  ?\C-c)))
  2049.     (set (make-local-variable 'echo-keystrokes) 0)
  2050.     (make-local-variable 'blink-matching-paren)
  2051.     (if evi-meta-prefix-char
  2052.         (set (make-local-variable 'meta-prefix-char)
  2053.          evi-meta-prefix-char))
  2054.     (evi-set-continuation 'evi-standard-continuation)
  2055.     (setq evi-keymap-list evi-vi-keymap-list)))
  2056.   (or (boundp 'minor-mode-map-alist)
  2057.       (use-local-map evi-top-level-map))
  2058.   (and buffer-read-only buffer-file-name
  2059.        (progn (or evi-read-only-buffers
  2060.           (toggle-read-only))
  2061.           (setq evi-buffer-read-only t)))
  2062.   (evi-change-mode-id evi-command-mode-string)
  2063.   (or evi-enabled
  2064.       (progn
  2065.     (evi-show-match evi-show-match)
  2066.     (evi-tab-width evi-tab-width)
  2067.     (evi-wrap-margin evi-wrap-margin)
  2068.     (run-hooks 'evi-mode-hook)))
  2069.   (setq evi-enabled t)
  2070.   (evi-refresh-mode-line))
  2071.  
  2072. (defun evi-quit-evi ()
  2073.   "Quit vi emulation in this buffer."
  2074.   (interactive)
  2075.   (setq evi-enabled nil)
  2076.   (evi-deinstall-from-mode-line 'evi-mode-string)
  2077.   (or (boundp 'minor-mode-map-alist)
  2078.       (use-local-map evi-emacs-local-map))
  2079.   (kill-local-variable 'meta-prefix-char)
  2080. ;  (if (eq evi-emacs-version 'lucid19)
  2081. ;      (restore-quit-char))
  2082.   (evi-refresh-mode-line)
  2083.   (run-hooks 'evi-mode-exit-hook))
  2084.  
  2085. ;; Minibuffer
  2086.  
  2087. (defun evi-backward-char-maybe-abort (&optional count)
  2088.   "Backup, aborting command if at beginning of input."
  2089.   (interactive (evi-count-arg))
  2090.   (let ((start (point)))
  2091.     (beginning-of-line)
  2092.     (if (< (- start (or count 1) (point)) (length evi-minibuf-prompt))
  2093.     (evi-abort-minibuf)
  2094.       (goto-char start)
  2095.       (do-evi-backward-char count))))
  2096.  
  2097. (defun evi-delete-backward-char-maybe-abort ()
  2098.   "Backup and delete previous character, aborting command if at
  2099. beginning of input."
  2100.   (interactive)
  2101.   (let ((start (point)))
  2102.     (beginning-of-line)
  2103.     (if (<= (- start (point)) (length evi-minibuf-prompt))
  2104.     (evi-abort-minibuf)
  2105.       (goto-char start)
  2106.       (delete-backward-char 1))))
  2107.  
  2108. ;; Scrolling
  2109.  
  2110. (defun evi-scroll-page-forward (&optional count)
  2111.   "Scroll COUNT pages forward."
  2112.   (interactive (evi-count-arg))
  2113.   (scroll-up (if (eq (or count 1) 1)
  2114.            (- (window-height) 3)
  2115.            (* (1- (window-height)) (or count 1))))
  2116.   (evi-reset-goal-column))
  2117.  
  2118. (defun evi-scroll-page-backward (&optional count)
  2119.   "Scroll COUNT pages backward."
  2120.   (interactive (evi-count-arg))
  2121.   (scroll-down (if (eq (or count 1) 1)
  2122.          (- (window-height) 3)
  2123.          (* (1- (window-height)) (or count 1))))
  2124.   (evi-reset-goal-column))
  2125.  
  2126. (defun evi-scroll-text-forward (&optional count)
  2127.   "Scroll COUNT lines forward.  Default is one half of a page or the last COUNT
  2128. specified to either \\[evi-scroll-text-forward] or \\[evi-scroll-text-backward] if one was previously
  2129. given.  The position of the cursor on the screen is maintained."
  2130.   (interactive (evi-count-arg))
  2131.   (evi-set-goal-column)
  2132.   (let ((line-count (if count
  2133.               (setq evi-scroll-count count)
  2134.               (or evi-scroll-count (/ (1- (window-height)) 2))))
  2135.     (window-line (count-lines (window-start) (1+ (point)))))
  2136.     (scroll-up line-count)
  2137.     (forward-line (min (1- window-line) line-count))
  2138.     (evi-move-to-column evi-goal-column)))
  2139.  
  2140. (defun evi-scroll-text-backward (&optional count)
  2141.   "Scroll COUNT lines backward.  Default is one half of a page or the last COUNT
  2142. specified to either \\[evi-scroll-up] or \\[evi-scroll-down] if one was previously
  2143. given.  The position of the cursor on the screen is maintained."
  2144.   (interactive (evi-count-arg))
  2145.   (evi-set-goal-column)
  2146.   (let ((line-count (if count
  2147.               (setq evi-scroll-count count)
  2148.               (or evi-scroll-count (/ (1- (window-height)) 2))))
  2149.     (window-line (count-lines (window-start) (1+ (point)))))
  2150.     (scroll-down line-count)
  2151.     (forward-line (- (min (- (1- (window-height)) window-line) line-count)))
  2152.     (evi-move-to-column evi-goal-column)))
  2153.  
  2154. (defun evi-scroll-cursor-forward (&optional count)
  2155.   "Scroll COUNT lines forward.  Maintain cursor position in the file
  2156. if possible."
  2157.   (interactive (evi-count-arg))
  2158.   (evi-set-goal-column)
  2159.   (scroll-up (or count 1))
  2160.   (evi-move-to-column evi-goal-column))
  2161.  
  2162. (defun evi-scroll-cursor-backward (&optional count)
  2163.   "Scroll COUNT lines backward.  Maintain cursor position in the file
  2164. if possible."
  2165.   (interactive (evi-count-arg))
  2166.   (evi-set-goal-column)
  2167.   (scroll-down (or count 1))
  2168.   (evi-move-to-column evi-goal-column))
  2169.  
  2170. (defun evi-window-control (char &optional linenumber)
  2171.   "Position current line on the screen according to the following character.
  2172. With a prefix count, position that line."
  2173.   (interactive (evi-character-arg))
  2174.   (if linenumber
  2175.     (do-evi-goto-line linenumber))
  2176.   (cond ((and (>= char ?0) (<= char ?9))
  2177.       (let* ((count (evi-read-number (- char ?0)))
  2178.          (char (evi-read-command-char)))
  2179.         (cond ((= char ?.) (enlarge-window (- count (1- (window-height)))))
  2180.           ((= char ?+) (enlarge-window count))
  2181.           ((= char ?-) (shrink-window count))
  2182.           ((= char ?=) (cond ((= count 0) (delete-window))
  2183.                      ((= count 1) (delete-other-windows))
  2184.                      ((= count 2) (split-window-vertically))
  2185.                      (t (evi-error "Invalid window op"))))
  2186.           ((= char ?|) (cond ((= count 0) (delete-window))
  2187.                      ((= count 1) (delete-other-windows))
  2188.                      ((= count 2)
  2189.                     (split-window-horizontally)))))))
  2190.     ((or (= char ?f) (= char ?n)) (select-window (next-window)))
  2191.     ((or (= char ?b) (= char ?p)) (select-window (previous-window)))
  2192.     (t
  2193.       (let ((position
  2194.           (cond ((or (eq char ?\r) (eq char ?H)) 0)
  2195.             ((or (eq char ?.) (eq char ?M)) (/ (window-height) 2))
  2196.             ((or (eq char ?-) (eq char ?L)) (- (window-height) 2))
  2197.             (t (evi-error "Invalid window op")))))
  2198.         (recenter position))))
  2199.   (if evi-prompted (message "")))
  2200.  
  2201. ;; unlike the motion commands, the scroll commands have no wrapper function
  2202. ;; to fixup the cursor, soo...
  2203. (defun evi-move-to-column (column)
  2204.   (move-to-column column)
  2205.   (if (and (eolp) (not (bolp)))
  2206.     (backward-char)))
  2207.  
  2208. ;; Insert mode
  2209.  
  2210. (defun evi-insert (&optional count)
  2211.   "Enter insert mode."
  2212.   (interactive (evi-count-arg))
  2213.   (setq evi-insert-point (point))
  2214.   (evi-undo-boundary)
  2215.   (evi-enter-insert count))
  2216.  
  2217. (defun evi-insert-after (&optional count)
  2218.   "Enter insert mode after the current point."
  2219.   (interactive (evi-count-arg))
  2220.   (if (or (not (bolp)) (not (eolp)))
  2221.       (forward-char))
  2222.   (evi-insert count))
  2223.  
  2224. (defun evi-open-after (&optional count)
  2225.   "Open a new line below the current one and enter insert mode."
  2226.   (interactive (evi-count-arg))
  2227.   (end-of-line)
  2228.   (insert ?\n)
  2229.   (setq evi-insert-point (point))
  2230.   (evi-maybe-indent)
  2231.   (evi-enter-insert count))
  2232.  
  2233. (defun evi-open-before (&optional count)
  2234.   "Open a new line above the current one and enter insert mode."
  2235.   (interactive (evi-count-arg))
  2236.   (beginning-of-line)
  2237.   (insert ?\n)
  2238.   (backward-char)
  2239.   (setq evi-insert-point (point))
  2240.   (evi-maybe-indent t)
  2241.   (evi-enter-insert count))
  2242.  
  2243. (defun evi-enter-insert (count)
  2244.   (evi-extend-continuation 'evi-exit-insert count)
  2245.   (evi-suspend-continuation)
  2246.   (evi-insert-mode))
  2247.  
  2248. (defun evi-insert-mode ()
  2249.   (setq evi-mode 'insert)
  2250.   (and (eobp) (not buffer-read-only)
  2251.        (progn (newline 1) (backward-char 1)))
  2252.   (or evi-in-minibuf
  2253.       (progn (evi-change-mode-id evi-insert-mode-string)
  2254.          (evi-refresh-mode-line)))
  2255.   (setq evi-keymap-list
  2256.     (append (list evi-input-map-map)
  2257.         (list evi-buffer-local-input-map)
  2258.         (if (boundp 'minor-mode-map-alist)
  2259.             (if evi-insert-mode-local-bindings
  2260.             (list (cons 'minor nil)
  2261.                   (cons 'emacs
  2262.                     (cons 'local
  2263.                       evi-emacs-local-suppress-key-list))))
  2264.           (if (and evi-insert-mode-local-bindings evi-emacs-local-map)
  2265.               (list (cons evi-emacs-local-suppress-key-list
  2266.                   evi-emacs-local-map))))
  2267.         (list evi-insert-map evi-input-map))))
  2268.  
  2269. (defun evi-exit-insert (&optional count)
  2270.   (evi-maybe-kill-indentation)
  2271.   (evi-exit-input-mode count)
  2272.   (if (not (bolp)) (backward-char))
  2273.   (evi-reset-goal-column)
  2274.   (evi-save-command-keys))
  2275.  
  2276. (defun evi-exit-input-mode (&optional count)
  2277.   "Exit from an input mode."
  2278.   (interactive)
  2279.   (ex-expand-abbrev)
  2280.   (if count
  2281.     (let ((input-string (buffer-substring evi-insert-point (point))))
  2282.       (evi-iterate (1- count)
  2283.     (insert input-string))))
  2284.   (setq evi-mode 'vi
  2285.     evi-keymap-list evi-vi-keymap-list)
  2286.   (or evi-in-minibuf
  2287.       (progn (evi-change-mode-id evi-command-mode-string)
  2288.          (evi-refresh-mode-line))))
  2289.  
  2290. (defun evi-insert-mode-delete-backward-char ()
  2291.   "Backup and delete previous character, but no further than insert point."
  2292.   (interactive)
  2293.   (if (> (point) evi-insert-point)
  2294.     (delete-backward-char 1)
  2295.     (message "Beginning of inserted text")))
  2296.  
  2297. (defun evi-insert-mode-delete-backward-word ()
  2298.   "Backup and delete previous word, but no further than insert point."
  2299.   (interactive)
  2300.   (if (<= (point) evi-insert-point)
  2301.       (message "Beginning of inserted text")
  2302.     (let ((start (point)))
  2303.       (do-evi-backward-word)
  2304.       (if (< (point) evi-insert-point)
  2305.       (goto-char evi-insert-point))
  2306.       (delete-region (point) start))))
  2307.  
  2308. (defun evi-insert-mode-kill-line ()
  2309.   "Kill current line, but no further than insert point."
  2310.   (interactive)
  2311.   (if (<= (point) evi-insert-point)
  2312.       (message "Beginning of inserted text")
  2313.     (let ((start (point)))
  2314.       (beginning-of-line)
  2315.       (and evi-in-minibuf
  2316.        ;; ZZ - kludge-check for "[{" and escape the `['
  2317.        (looking-at (concat (if (= (aref evi-minibuf-prompt 0) ?\[) "\\")
  2318.                    evi-minibuf-prompt))
  2319.        (forward-char (length evi-minibuf-prompt)))
  2320.       (if (< (point) evi-insert-point)
  2321.       (goto-char evi-insert-point))
  2322.       (delete-region (point) start))))
  2323.  
  2324. (defun evi-maybe-indent (&optional forward)
  2325.   (interactive)
  2326.   (if evi-auto-indent
  2327.     (progn
  2328.       (let ((start (point)))
  2329.     (skip-chars-forward " \t")
  2330.     (delete-region start (point)))
  2331.       (if (or (not evi-insert-mode-local-bindings)
  2332.           (eq indent-line-function 'indent-to-left-margin))
  2333.     (indent-to (save-excursion
  2334.              (if forward (forward-char) (backward-char))
  2335.              (current-indentation)))
  2336.     (indent-according-to-mode))
  2337.       (setq evi-current-indentation (current-column)))))
  2338.  
  2339. (defun evi-maybe-kill-indentation ()
  2340.   (and evi-auto-indent (= evi-current-indentation (current-column))
  2341.     (let ((region
  2342.        (save-excursion
  2343.          (let ((start (if (progn (skip-chars-backward " \t") (bolp))
  2344.                 (point))))
  2345.            (if (and start (progn (skip-chars-forward " \t") (eolp)))
  2346.          (cons start (point)))))))
  2347.       (if region
  2348.     (delete-region (car region) (cdr region))))))
  2349.  
  2350. (defun evi-newline ()
  2351.   "Insert a newline, and indent to the current indentation level.
  2352. Kills indentation on current line if the line is otherwise empty."
  2353.   (interactive)
  2354.   (ex-expand-abbrev)
  2355.   (let ((start (point)))
  2356.     (insert ?\n)
  2357.     (evi-maybe-indent)
  2358.     (save-excursion
  2359.       (goto-char start)
  2360.       (evi-maybe-kill-indentation))))
  2361.  
  2362. (defun evi-forward-indent ()
  2363.   "Move forward to the next indentation level, defined by shiftwidth."
  2364.   (interactive)
  2365.   ; eat all preceeding blanks, then fill with tabs, and pad with spaces
  2366.   ; to reach the target column
  2367.   (let* ((start-column (current-column))
  2368.      (target-column (+ start-column (- evi-shift-width
  2369.                        (% start-column evi-shift-width))))
  2370.      (backup-point (save-excursion
  2371.              (skip-chars-backward " ")
  2372.              (point))))
  2373.     (delete-backward-char (- (point) backup-point))
  2374.     (if indent-tabs-mode
  2375.     (while (< (setq start-column (current-column)) target-column)
  2376.       (insert ?\t)))
  2377.     (if (> start-column target-column) (delete-backward-char 1))
  2378.     (insert-char ?\ (- target-column (current-column)))))
  2379.  
  2380. (defun evi-calc-backward-indent ()
  2381.   (let* ((start-column (current-column))
  2382.      (offset (let ((toffset (% start-column evi-shift-width)))
  2383.            (if (= toffset 0) evi-shift-width toffset)))
  2384.      (furthest (save-excursion
  2385.              (skip-chars-backward " \t" (max 0 (- (point) offset)))
  2386.              (- start-column (current-column)))))
  2387.     (min offset furthest)))
  2388.  
  2389. (defun evi-backward-indent ()
  2390.   "Move backward to the previous indentation level, defined by shiftwidth."
  2391.   (interactive)
  2392.   (backward-delete-char-untabify (evi-calc-backward-indent) nil))
  2393.  
  2394. (defun evi-replace-mode-backward-indent ()
  2395.   "Move backward to the previous indentation level, defined by shiftwidth."
  2396.   (interactive)
  2397.   (if (<= (point) evi-insert-point)
  2398.       (message "Beginning of replaced text")
  2399.     (let ((offset (evi-calc-backward-indent)))
  2400.       (if (> offset evi-replaced-string-index)
  2401.       (progn (setq evi-replaced-string-index 0)
  2402.          (goto-char evi-insert-point))
  2403.     (setq evi-replaced-string-index (- evi-replaced-string-index offset))
  2404.     (goto-char (- (point) offset))))))
  2405.  
  2406. (defun evi-quoted-insert ()
  2407.   (interactive)
  2408.   (insert (evi-read-char)))
  2409.  
  2410. ;; Replace mode
  2411.  
  2412. (defun evi-replace ()
  2413.   "Enter replace mode."
  2414.   (interactive)
  2415.   (evi-undo-boundary)
  2416.   (setq evi-mode 'replace)
  2417.   (evi-extend-continuation 'evi-exit-replace)
  2418.   (evi-suspend-continuation)
  2419.   (evi-replace-mode (1- (point-max))))
  2420.  
  2421. (defun evi-replace-mode (max-replace-position)
  2422.   (or evi-replace-max
  2423.       (setq evi-replace-max (make-marker)))
  2424.   (set-marker evi-replace-max max-replace-position)
  2425.   (setq evi-insert-point (point)
  2426.     evi-replaced-string ""
  2427.     evi-replaced-string-index 0)
  2428.   (evi-change-mode-id evi-replace-mode-string)
  2429.   (evi-refresh-mode-line)
  2430.   (setq evi-keymap-list
  2431.     (append (list evi-input-map-map)
  2432.         (list evi-buffer-local-input-map)
  2433.         (if (boundp 'minor-mode-map-alist)
  2434.             (if evi-insert-mode-local-bindings
  2435.             (list (cons 'minor nil)
  2436.                   (cons 'emacs
  2437.                     (cons 'local
  2438.                       evi-emacs-local-suppress-key-list))))
  2439.           (if (and evi-insert-mode-local-bindings evi-emacs-local-map)
  2440.               (list (cons evi-emacs-local-suppress-key-list
  2441.                   evi-emacs-local-map))))
  2442.         (list evi-replace-map evi-input-map))))
  2443.  
  2444. (defun evi-switch-to-insert ()
  2445.   ;ZZ(setq evi-command-keys loop-command-keys)
  2446.   (set-marker evi-replace-max nil)
  2447.   (evi-insert-mode))
  2448.  
  2449. (defun evi-exit-replace ()
  2450.   (if (eq evi-mode 'insert)
  2451.       (evi-exit-insert)
  2452.     (if (< evi-replaced-string-index (length evi-replaced-string))
  2453.     (let ((start (point)))
  2454.       (delete-region (point)
  2455.              (+ (point) (- (length evi-replaced-string)
  2456.                        evi-replaced-string-index)))
  2457.       (insert-before-markers
  2458.         (substring evi-replaced-string evi-replaced-string-index))
  2459.       (goto-char start)))
  2460.     (if (eq evi-mode 'change)
  2461.     (evi-exit-change-mode))
  2462.     (setq evi-overstruck-char nil)
  2463.     (evi-exit-input-mode)
  2464.     (if (not (bolp)) (backward-char))
  2465.     (if evi-replace-max
  2466.     (set-marker evi-replace-max nil))
  2467.     (evi-reset-goal-column)
  2468.     (evi-save-command-keys)))
  2469.  
  2470. (defun evi-self-replace ()
  2471.   "Replace character under cursor with the command character."
  2472.   (interactive)
  2473.   (evi-kill-undo-boundary)
  2474.   (if (or (>= (point) evi-replace-max)
  2475.       (= (following-char) ?\n))
  2476.       (progn (evi-push-macro (char-to-string last-command-char))
  2477.          (evi-switch-to-insert))
  2478.     (if (= evi-replaced-string-index (length evi-replaced-string))
  2479.     (setq evi-replaced-string
  2480.           (concat evi-replaced-string
  2481.               (char-to-string (following-char)))))
  2482.     (setq evi-replaced-string-index (1+ evi-replaced-string-index))
  2483.     (let ((start (point)))
  2484.       (evi-replace-one-char last-command-char)
  2485.       ;; if auto-indenting happened...
  2486.       (if (> (- (point) start) 1)
  2487.       (setq evi-insert-point (1+ start)
  2488.         evi-replaced-string
  2489.         (buffer-substring (1+ start) (point))
  2490.         evi-replaced-string-index
  2491.         (length evi-replaced-string))))))
  2492.  
  2493. (defun evi-replace-one-char (char)
  2494.   (delete-region (point) (1+ (point)))
  2495.   (if (boundp 'buffer-undo-list)
  2496.       (if (and evi-overstruck-char (= (point) evi-replace-max))
  2497.       (progn (evi-change-last-undo 0 evi-overstruck-char)
  2498.          (setq evi-overstruck-char nil))))
  2499.   ;; ZZ unpleasantly hardcoded?
  2500.   (if (or (= char ?\n) (= char ?\r))
  2501.       (evi-newline)
  2502.     (insert char)))
  2503.  
  2504. ;; ZZ can probably generalize to account for both insert and replace on
  2505. ;; at least these three
  2506.  
  2507. (defun evi-replace-mode-delete-backward-char ()
  2508.   "Backup to previous character, undoing last replacement, but no further
  2509. than insert point."
  2510.   (interactive)
  2511.   (if (<= (point) evi-insert-point)
  2512.       (message "Beginning of replaced text")
  2513.     (backward-char)
  2514.     (setq evi-replaced-string-index (1- evi-replaced-string-index))))
  2515.  
  2516. (defun evi-replace-mode-delete-backward-word ()
  2517.   "Backup and delete previous word, but no further than insert point."
  2518.   (interactive)
  2519.   (if (<= (point) evi-insert-point)
  2520.       (message "Beginning of replaced text")
  2521.     (let ((start (point)))
  2522.       (do-evi-backward-word)
  2523.       (if (< (point) evi-insert-point)
  2524.       (goto-char evi-insert-point))
  2525.       (setq evi-replaced-string-index
  2526.         (- evi-replaced-string-index (- start (point)))))))
  2527.  
  2528. (defun evi-replace-mode-kill-line ()
  2529.   "Kill current line, but no further than insert point."
  2530.   (interactive)
  2531.   (if (<= (point) evi-insert-point)
  2532.       (message "Beginning of replaced text")
  2533.     (let ((start (point)))
  2534.       (beginning-of-line)
  2535.       (and evi-in-minibuf
  2536.        ;; ZZ - kludge-check for "[{" and escape the `['
  2537.        (looking-at (concat (if (= (aref evi-minibuf-prompt 0) ?\[) "\\")
  2538.                    evi-minibuf-prompt))
  2539.        (forward-char (length evi-minibuf-prompt)))
  2540.       (if (< (point) evi-insert-point)
  2541.       (goto-char evi-insert-point))
  2542.       (setq evi-replaced-string-index 0))))
  2543.  
  2544. (defun evi-replace-char (char &optional count)
  2545.   "Replace the following COUNT characters with CHAR."
  2546.   (interactive (evi-character-arg))
  2547.   (if (catch 'abort
  2548.     (evi-motion-command 'do-evi-forward-char 'horizontal count 'to-end))
  2549.       (evi-error "Can't replace that many characters")
  2550.     (evi-exchange-point-and-mark)
  2551.     (evi-iterate (or count 1)
  2552.       (evi-replace-one-char char))
  2553.     ;; ZZ unpleasantly hard-coded?
  2554.     ;; should be handled by a general purpose post-auto-indent func
  2555.     (if (or (= char ?\n) (= char ?\r))
  2556.     (evi-maybe-kill-indentation))
  2557.     (if (not (bolp)) (backward-char)))
  2558.   (evi-reset-goal-column)
  2559.   (evi-save-command-keys))
  2560.  
  2561. (defun evi-toggle-case (&optional count)
  2562.   "Toggle the case of the following COUNT characters."
  2563.   (interactive (evi-count-arg))
  2564.   (evi-motion-command 'do-evi-forward-char 'horizontal count 'to-end)
  2565.   (save-excursion
  2566.     (evi-iterate (- (point) evi-mark)
  2567.       (backward-char)
  2568.       (let ((char (following-char)))
  2569.     (cond ((and (>= char ?a) (<= char ?z))
  2570.         (upcase-region (point) (1+ (point))))
  2571.           ((and (>= char ?A) (<= char ?Z))
  2572.         (downcase-region (point) (1+ (point))))))))
  2573.   (evi-fixup-cursor 'horizontal)
  2574.   (evi-reset-goal-column)
  2575.   (evi-save-command-keys))
  2576.  
  2577. ;; Modification operators
  2578.  
  2579. (defun evi-change (&optional count)
  2580.   "Change operator."
  2581.   (interactive (evi-count-arg))
  2582.   (evi-extend-continuation 'evi-operator-after-after)
  2583.   (evi-push-continuation 'evi-change-internal)
  2584.   (evi-operator-command count 'to-end))
  2585.  
  2586. (defun evi-change-internal ()
  2587.   ; If the region is contained on one line, throw a `$' out to mark the
  2588.   ; end of the region, then enter replace mode and delete any un-replaced
  2589.   ; text when that is exited, with the replace-max set at the end of the
  2590.   ; region so that it will switch to insert mode if necessary.  Otherwise,
  2591.   ; delete the region first, and enter insert mode.
  2592.   (evi-copy-region-to-registers t)
  2593.   ; this makes the undo leave the point at the start of the undone text
  2594.   (evi-exchange-point-and-mark)
  2595.   (if (or (save-excursion (end-of-line) (> evi-mark (point)))
  2596.       (= (point) evi-mark))
  2597.       (progn (evi-report-action (point) evi-mark "changed")
  2598.          (delete-region (point) evi-mark)
  2599.          (evi-insert))
  2600.     (progn (setq evi-overstruck-char (char-after (1- evi-mark)))
  2601.        (let ((here (point)))
  2602.          (goto-char evi-mark)
  2603.          (delete-region (1- evi-mark) evi-mark)
  2604.          (insert ?$)
  2605.          (if (boundp 'buffer-undo-list)
  2606.          ;; this is a bit of song and dance to get the cursor to
  2607.          ;; end up in the right place after an undo.  the problem
  2608.          ;; is these two previous statements, which are the first
  2609.          ;; things changed, and thus where the cursor will be left
  2610.          ;; after an undo.  first step: erase the fact that we put
  2611.          ;; the dollar sign there in the first place.
  2612.          (setq buffer-undo-list (cdr (cdr buffer-undo-list))))
  2613.          (goto-char here))
  2614.        (setq evi-mode 'change)
  2615.        (evi-extend-continuation 'evi-exit-replace)
  2616.        (evi-suspend-continuation)
  2617.        (evi-replace-mode evi-mark))))
  2618.  
  2619. (defun evi-exit-change-mode ()
  2620.   (if (and (marker-position evi-replace-max)
  2621.        (< (point) evi-replace-max))
  2622.     (let ((overstrike-offset (1- (- evi-replace-max (point)))))
  2623.       (if (null (car buffer-undo-list))
  2624.       ;; an extra undo boundary crept in
  2625.       (setq buffer-undo-list (cdr buffer-undo-list)))
  2626.       (delete-region (point) (marker-position evi-replace-max))
  2627.       (set-marker evi-replace-max nil)
  2628.       (if (boundp 'buffer-undo-list)
  2629.       ;; second step: rewrite the undo record with the
  2630.       ;; original overstruck character
  2631.       (evi-change-last-undo overstrike-offset evi-overstruck-char)))))
  2632.  
  2633. (defun evi-delete (&optional count)
  2634.  "Delete operator."
  2635.   (interactive (evi-count-arg))
  2636.   (evi-extend-continuation 'evi-operator-after-after)
  2637.   (evi-extend-continuation 'evi-delete-internal)
  2638.   (evi-operator-command count 'to-next))
  2639.  
  2640. (defun evi-delete-internal ()
  2641.   (evi-copy-region-to-registers t)
  2642.   ; this makes the undo leave the point at the start of the undone text
  2643.   (evi-exchange-point-and-mark)
  2644.   (if (= (point) evi-mark)
  2645.       (message "Nothing deleted")
  2646.     (evi-report-action evi-mark (point) "deleted")
  2647.     (if (eq evi-region-shape 'rectangle)
  2648.     (delete-rectangle (point) (1+ evi-mark))
  2649.       (delete-region (point) evi-mark)))
  2650.   (evi-fixup-cursor (if (eq evi-region-shape 'chars) 'horizontal 'vertical)))
  2651.  
  2652. (defun evi-yank (&optional count)
  2653.   "Yank operator."
  2654.   (interactive (evi-count-arg))
  2655.   (evi-extend-continuation 'evi-operator-after-after)
  2656.   (evi-extend-continuation 'evi-yank-internal (point))
  2657.   (evi-operator-command count 'to-next))
  2658.  
  2659. (defun evi-yank-internal (start)
  2660.   (evi-copy-region-to-registers nil)
  2661.   (if (= evi-mark (point))
  2662.       (message "Nothing to yank")
  2663.     (evi-report-action evi-mark (point) "yanked"))
  2664.   (goto-char start))
  2665.  
  2666. (defun evi-put-after (&optional register-number register-append count)
  2667.   "Put back yanked or deleted text after cursor."
  2668.   (interactive (evi-register-args))
  2669.   (let ((register
  2670.       (aref evi-registers (or register-number evi-register-unnamed))))
  2671.     (if register
  2672.     (if (eq (evi-register-shape register) 'lines)
  2673.         (progn (end-of-line)
  2674.            (if (not (eobp)) (forward-char))
  2675.            (save-excursion
  2676.              (evi-iterate (or count 1)
  2677.                (insert (evi-register-text register)))))
  2678.       (if (not (and (bolp) (eolp)))
  2679.           (forward-char))
  2680.       (evi-iterate (or count 1)
  2681.         (if (eq (evi-register-shape register) 'chars)
  2682.         (insert (evi-register-text register))
  2683.           (insert-rectangle (evi-register-text register))))
  2684.       (backward-char))
  2685.       (if register-number
  2686.       (message "Nothing in register %c"
  2687.            (evi-register-name register-number))
  2688.     (message "No text to put"))))
  2689.   (evi-reset-goal-column)
  2690.   (evi-save-command-keys))
  2691.  
  2692. (defun evi-put (&optional register-number register-append count)
  2693.   "Put back yanked or deleted text."
  2694.   (interactive (evi-register-args))
  2695.   (let ((register
  2696.       (aref evi-registers (or register-number evi-register-unnamed))))
  2697.     (if register
  2698.     (if (eq (evi-register-shape register) 'lines)
  2699.         (progn (beginning-of-line)
  2700.            (save-excursion
  2701.              (evi-iterate (or count 1)
  2702.                (insert (evi-register-text register)))))
  2703.       (evi-iterate (or count 1)
  2704.         (if (eq (evi-register-shape register) 'chars)
  2705.         (insert (evi-register-text register))
  2706.           (insert-rectangle (evi-register-text register))))
  2707.       (backward-char))
  2708.       (if register-number
  2709.       (message "Nothing in register %c"
  2710.            (evi-register-name register-number))
  2711.     (message "No text to put"))))
  2712.   (evi-reset-goal-column)
  2713.   (evi-save-command-keys))
  2714.  
  2715. (defun evi-shift-right (&optional count)
  2716.   "Shift right operator."
  2717.   (interactive (evi-count-arg))
  2718.   (evi-extend-continuation 'evi-operator-after-after)
  2719.   (evi-extend-continuation 'evi-shift-internal 1)
  2720.   (evi-operator-command count 'whole-lines))
  2721.  
  2722. (defun evi-shift-left (&optional count)
  2723.   "Shift left operator."
  2724.   (interactive (evi-count-arg))
  2725.   (evi-extend-continuation 'evi-operator-after-after)
  2726.   (evi-extend-continuation 'evi-shift-internal -1)
  2727.   (evi-operator-command count 'whole-lines))
  2728.  
  2729. (defun evi-shift-internal (direction)
  2730.   (if (= evi-mark (point))
  2731.     (message "Nothing shifted")
  2732.     (indent-rigidly evi-mark (point) (* evi-shift-width direction)))
  2733.   (goto-char evi-mark)
  2734.   (skip-chars-forward " \t"))
  2735.  
  2736. (defun evi-indent (&optional count)
  2737.   "Indent region."
  2738.   (interactive (evi-count-arg))
  2739.   (evi-extend-continuation 'evi-operator-after-after)
  2740.   (evi-extend-continuation 'evi-indent-internal)
  2741.   (evi-operator-command count 'whole-lines))
  2742.  
  2743. (defun evi-indent-internal ()
  2744.   (if (= evi-mark (point))
  2745.     (message "Nothing indented")
  2746.     (indent-region evi-mark (point) nil))
  2747.   (goto-char evi-mark)
  2748.   (skip-chars-forward " \t"))
  2749.  
  2750. (defun evi-shell-filter (&optional count)
  2751.   "Filter region thru shell command."
  2752.   (interactive (evi-count-arg))
  2753.   (evi-push-continuation 'evi-shell-filter2 (point))
  2754.   (evi-operator-command count 'whole-lines))
  2755.  
  2756. (defun evi-shell-filter2 (start)
  2757.   (evi-extend-continuation 'evi-operator-after-after)
  2758.   (evi-extend-continuation 'evi-filter-internal start)
  2759.   (evi-read-string "!"))
  2760.  
  2761. (defun evi-filter-internal (start)
  2762.   (if (string= evi-minibuf-contents "!")
  2763.       (setq evi-minibuf-contents
  2764.     (or evi-last-shell-command
  2765.         (evi-error "No previous shell command to substitute for !")))
  2766.     (setq evi-last-shell-command evi-minibuf-contents))
  2767.   (shell-command-on-region evi-mark (point) evi-minibuf-contents t)
  2768.   (goto-char start))
  2769.  
  2770. (defun evi-send-to-process (&optional count)
  2771.   "Send region to emacs process buffer."
  2772.   (interactive (evi-count-arg))
  2773.   (evi-push-continuation 'evi-send-to-process2 (point))
  2774.   (evi-operator-command count 'to-next))
  2775.  
  2776. (defun evi-send-to-process2 (start)
  2777.   (evi-extend-continuation 'evi-operator-after-after)
  2778.   (evi-extend-continuation 'evi-to-process-internal start)
  2779.   (evi-read-string "*"))
  2780.  
  2781. (defun evi-to-process-internal (start)
  2782.   (let ((end (point)))
  2783.     (goto-char start)
  2784.     (if (string= evi-minibuf-contents "*")
  2785.     (or evi-process-buffer
  2786.         (evi-error "No previous process to substitute for *"))
  2787.       (setq evi-process-buffer evi-minibuf-contents))
  2788.     (send-region evi-process-buffer evi-mark end))
  2789.   (setq evi-delayed-buffer-change-request
  2790.     (cons 'other
  2791.           (cons evi-process-buffer
  2792.             '(progn
  2793.                (goto-char (process-mark
  2794.                     (get-buffer-process evi-process-buffer)))
  2795.                (evi-insert))))))
  2796.  
  2797. ; ZZ we may want to expand the region to lines here?  or not
  2798. (defun evi-loop-over-lines-in-region (&optional count)
  2799.   "Execute a sequence of operations on every line in a region."
  2800.   (interactive (evi-count-arg))
  2801.   (evi-push-continuation 'evi-loop-over-lines2)
  2802.   (evi-operator-command count 'to-end))
  2803.  
  2804. (defun evi-loop-over-lines2 ()
  2805.   (evi-extend-continuation 'evi-operator-after-after)
  2806.   (evi-extend-continuation 'evi-loop-lines-internal)
  2807.   (evi-read-string "[{"))
  2808.  
  2809. (defun evi-loop-lines-internal ()
  2810.   (setq evi-last-command-keys nil
  2811.     evi-prefix-count nil)
  2812.   (let ((ending-mark (set-marker (make-marker) (point-marker))))
  2813.     (goto-char evi-mark)
  2814.     (beginning-of-line)
  2815.     (evi-push-macro evi-minibuf-contents
  2816.             'evi-loop-lines-internal2 evi-minibuf-contents
  2817.             ending-mark)))
  2818.  
  2819. (defun evi-loop-lines-internal2 (macro ending-mark)
  2820.   (end-of-line)
  2821.   (forward-char)
  2822.   (evi-db (concat "{" (prin1-to-string (point)) "," (prin1-to-string (marker-position ending-mark)) "}"))
  2823.   (if (< (point) (marker-position ending-mark))
  2824.       (evi-push-macro macro 'evi-loop-lines-internal2 macro ending-mark)
  2825.     (set-marker ending-mark nil)
  2826.     (evi-fixup-cursor 'vertical)))
  2827.  
  2828. (defun evi-operator-command (count context)
  2829.   (evi-push-continuation 'evi-operator-after (list 'quote evi-keymap-list))
  2830.   (setq evi-context context
  2831.     evi-prefix-count-multiplier count
  2832.     evi-prefix-count nil
  2833.     evi-keymap-list
  2834.       (cons (evi-make-local-keymap
  2835.           '(((char-to-string last-command-char) evi-whole-lines)))
  2836.         (list (cons 'param evi-param-map) (cons 'map evi-map-map)
  2837.               evi-motion-map)))
  2838.   (evi-push-continuation 'evi-prompt))
  2839.  
  2840. ; this happens after the motion command
  2841. (defun evi-operator-after (old-keymap-list)
  2842.   (setq evi-keymap-list old-keymap-list
  2843.     evi-context nil
  2844.     evi-prefix-count-multiplier nil)
  2845.   (evi-pop-continuation))
  2846.  
  2847. ; this happens after the entire operation
  2848. (defun evi-operator-after-after ()
  2849.   (evi-reset-goal-column)
  2850.   (evi-save-command-keys))
  2851.  
  2852. (defun evi-join-lines (&optional count)
  2853.   "Join together COUNT + 1 lines, supplying appropriate whitespace."
  2854.   (interactive (evi-count-arg))
  2855.   (let ((starting-point (point))
  2856.     (ending-point nil)
  2857.     (blank (and (eolp) (bolp))))
  2858.     (evi-iterate (max (1- (or count 2)) 1)
  2859.       (end-of-line)
  2860.       (if (evi-eobp)
  2861.       (progn (or ending-point
  2862.              (setq ending-point starting-point))
  2863.          (evi-break))
  2864.     (forward-char)
  2865.     (delete-region (1- (point))
  2866.                (progn (skip-chars-forward " \t") (point)))
  2867.     (or ending-point
  2868.         (setq ending-point (point)))
  2869.     (if (and (not blank)
  2870.          (/= (preceding-char) ? )
  2871.          (/= (preceding-char) ?\t)
  2872.          (/= (following-char) ?\)))
  2873.         (insert-char ?  (if (= (preceding-char) ?.) 2 1)))))
  2874.     (goto-char ending-point))
  2875.   (evi-reset-goal-column)
  2876.   (evi-save-command-keys))
  2877.  
  2878. ;; Motion command
  2879.  
  2880. (defun evi-exchange-point-and-mark ()
  2881.   (let ((temp evi-mark))
  2882.     (setq evi-mark (point))
  2883.     (goto-char temp)))
  2884.  
  2885. (defun evi-expand-region-to-lines (context)
  2886.   (evi-exchange-point-and-mark)
  2887.   (beginning-of-line)
  2888.   (evi-exchange-point-and-mark)
  2889.   (end-of-line)
  2890.   (if (not (or (eobp) (eq context 'to-end))) (forward-char))
  2891.   (setq evi-region-shape 'lines))
  2892.  
  2893. ; 'normalizing' a horizontal region means expanding the region to whole lines
  2894. ; when 1) the beginning of the region is on the first non-white character
  2895. ; of a line, and 2) the ending of the region is on the end of the line
  2896.  
  2897. (defun evi-normalize-region ()
  2898.   (and (eolp)
  2899.        (save-excursion
  2900.      (beginning-of-line)
  2901.      (and (> (point) evi-mark)
  2902.           (progn (goto-char evi-mark)
  2903.              (skip-chars-backward " \t")
  2904.              (bolp))))
  2905.        (progn (evi-exchange-point-and-mark)
  2906.           (beginning-of-line)
  2907.           (evi-exchange-point-and-mark)
  2908.           (if (not (eobp))
  2909.         (forward-char))
  2910.           (setq evi-region-shape 'lines))))
  2911.  
  2912. (defun evi-fixup-cursor (direction)
  2913.   (if (eq evi-mode 'vi)
  2914.       (if (eq direction 'horizontal)
  2915.       (progn (if (and (eobp) (not (bobp)))
  2916.              (backward-char))
  2917.          (if (and (eolp) (not (bolp)))
  2918.              (backward-char)))
  2919.     (if (and (eobp) (not (bobp)))
  2920.         (progn (backward-char) (beginning-of-line))
  2921.       (if (and (eolp) (not (bolp))) (backward-char))))))
  2922.  
  2923. (defun evi-motion-command (move-function direction count context &optional arg)
  2924.   (if context
  2925.       (setq evi-mark (point))
  2926.     ; else, maintain the goal column.  kinda gross this being here, but...
  2927.     (if (or (eq move-function 'do-evi-next-line)
  2928.         (eq move-function 'do-evi-previous-line))
  2929.     (evi-set-goal-column)
  2930.       (evi-reset-goal-column)))
  2931.   (if arg
  2932.       (funcall move-function arg count context)
  2933.     (funcall move-function count context))
  2934.   (if context
  2935.       (progn
  2936.     (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  2937.     (if (or (eq direction 'vertical) (eq context 'whole-lines))
  2938.         (evi-expand-region-to-lines context)
  2939.       (progn (setq evi-region-shape 'chars)
  2940.          (if (eq context 'to-next)
  2941.              (evi-normalize-region)))))
  2942.     ; fixup the location of the cursor, if necessary
  2943.     (evi-fixup-cursor direction)))
  2944.  
  2945. ;; Simple motion commands
  2946.  
  2947. (evi-defmotion horizontal evi-forward-char (&optional count context)
  2948.   "Move right COUNT characters on the current line."
  2949.   (let ((here (point)))
  2950.     (end-of-line)
  2951.     (if (< (or count 1) (- (point) here))
  2952.     (goto-char (+ here (or count 1)))))
  2953.   (and (eolp) (not context)
  2954.        (evi-error "End of line")))
  2955.  
  2956. (evi-defmotion horizontal evi-backward-char (&optional count context)
  2957.   "Move left COUNT characters on the current line."
  2958.   (let ((here (point)))
  2959.     (beginning-of-line)
  2960.     (if (< (1- (or count 1)) (- here (point)))
  2961.     (goto-char (- here (1- (or count 1))))))
  2962.   (if (bolp) (evi-error "Beginning of line") (backward-char)))
  2963.  
  2964. (evi-defmotion vertical evi-next-line (&optional count context)
  2965.   "Go to ARGth next line."
  2966.   (evi-next-line-internal (or count 1))
  2967.   (or context
  2968.       (progn (evi-adjust-scroll-up)
  2969.          (move-to-column evi-goal-column))))
  2970.  
  2971. (evi-defmotion vertical evi-beginning-of-next-line (&optional count context)
  2972.   "Go to beginning of ARGth next line."
  2973.   (evi-next-line-internal (or count 1))
  2974.   (or context
  2975.       (evi-adjust-scroll-up))
  2976.   (skip-chars-forward " \t"))
  2977.  
  2978. ;; ZZ maybe can use goal column in fixup-cursor to remove some of this here??
  2979. (defun evi-next-line-internal (count)
  2980.   (let* ((starting-point (point))
  2981.      (offset (forward-line count)))
  2982.     (or (not (eobp)) (= count 0)
  2983.     (progn (goto-char starting-point)
  2984.            (evi-error
  2985.          (if (= count 1)
  2986.              "Last line in buffer"
  2987.            "Not that many lines left in buffer"))))))
  2988.  
  2989. (if (fboundp 'window-end)
  2990.     (defun evi-adjust-scroll-up ()
  2991.       (let ((window-line (count-lines (window-start) (1+ (point))))
  2992.         (window-height (1- (window-height))))
  2993.     (and (>= (point) (window-end))
  2994.          (< window-line (+ window-height (/ window-height 3)))
  2995.          (let ((start (point)))
  2996.            (end-of-line)
  2997.            (recenter -1)
  2998.            (goto-char start)))))
  2999.   (defun evi-adjust-scroll-up ()
  3000.     (let* ((window-line (count-lines (window-start) (1+ (point))))
  3001.        (window-height (1- (window-height)))
  3002.        (window-end (save-excursion (goto-char (window-start))
  3003.                        (forward-line window-height)
  3004.                        (point))))
  3005.       (and (>= (point) window-end)
  3006.        (< window-line (+ window-height (/ window-height 3)))
  3007.     (recenter -1)))))
  3008.  
  3009. (evi-defmotion vertical evi-previous-line (&optional count context)
  3010.   "Go to ARGth previous line."
  3011.   (evi-previous-line-internal (or count 1))
  3012.   (or context
  3013.       (progn (evi-adjust-scroll-down)
  3014.          (move-to-column evi-goal-column))))
  3015.  
  3016. (evi-defmotion vertical evi-beginning-of-previous-line (&optional count context)
  3017.   "Go to beginning of ARGth previous line."
  3018.   (evi-previous-line-internal (or count 1))
  3019.   (or context
  3020.       (evi-adjust-scroll-down))
  3021.   (back-to-indentation))
  3022.  
  3023. (defun evi-previous-line-internal (count)
  3024.   (let* ((starting-point (point))
  3025.      (offset (forward-line (- count))))
  3026.     (if (/= offset 0)
  3027.     (progn (goto-char starting-point)
  3028.            (evi-error
  3029.          (if (= count 1)
  3030.              "First line in buffer"
  3031.            "Not that many lines left in buffer"))))))
  3032.  
  3033. (defun evi-adjust-scroll-down ()
  3034.   (if (< (point) (window-start))
  3035.     (let ((window-line (count-lines (1+ (point)) (window-start)))
  3036.       (window-height (1- (window-height))))
  3037.       (and (< window-line (/ window-height 3))
  3038.        (recenter 0)))))
  3039.  
  3040. (evi-defmotion vertical evi-goto-line (&optional count context)
  3041.   "Go to line number LINE, or to end of file if no count specified."
  3042.   ; ZZ once again... if we know the move won't be far (like on same screen)
  3043.   ; perhaps shouldn't push context...
  3044.   (evi-push-context)
  3045.   (ex-goto-line count))
  3046.  
  3047. (evi-defmotion vertical evi-goto-top-of-window (&optional offset context)
  3048.   "Go to the top line of the window.  With an arg, OFFSET, goes to the
  3049. OFFSET'th line of the window."
  3050.   (move-to-window-line (1- (or offset 1)))
  3051.   (or context
  3052.       (skip-chars-forward " \t")))
  3053.  
  3054. (evi-defmotion vertical evi-goto-middle-of-window (&optional offset context)
  3055.   "Go to the middle line of the window."
  3056.   (move-to-window-line (/ (window-height) 2))
  3057.   (or context
  3058.       (skip-chars-forward " \t")))
  3059.  
  3060. (evi-defmotion vertical evi-goto-bottom-of-window (&optional offset context)
  3061.   "Go to the bottom line of the window.  With an arg, OFFSET, goes to the
  3062. OFFSET'th line from the bottom of the window."
  3063.   (move-to-window-line (- (1- (window-height)) (or offset 1)))
  3064.   (or context
  3065.       (skip-chars-forward " \t")))
  3066.  
  3067. (evi-defmotion horizontal evi-goto-column (&optional column context)
  3068.   "Go to column COLUMN, or as close to that column as possible."
  3069.   (move-to-column (1- (or column 1))))
  3070.  
  3071. (evi-defmotion vertical evi-whole-lines (&optional count context)
  3072.   "Go ARG - 1 lines forward."
  3073.   (evi-next-line-internal (1- (or count 1))))
  3074.  
  3075. (evi-defmotion horizontal evi-beginning-of-line (&optional count context)
  3076.   "Go to beginning of line."
  3077.   (beginning-of-line))
  3078.  
  3079. ; it's not at all clear why this doesn't take a count...
  3080. ; maybe it should...
  3081. (evi-defmotion horizontal evi-goto-indentation (&optional count context)
  3082.   "Go to beginning of indented text on current line."
  3083.   (beginning-of-line)
  3084.   (back-to-indentation))
  3085.  
  3086. (evi-defmotion horizontal evi-end-of-line (&optional count context)
  3087.   "Go to end of line."
  3088.   (evi-next-line-internal (1- (or count 1)))
  3089.   (end-of-line)
  3090.   ;; any sufficiently large number here will do
  3091.   (setq evi-goal-column 1000000
  3092.     evi-reset-goal-column nil))
  3093.  
  3094. ;; Word, sentence, paragraph and section motion commands
  3095.  
  3096. (defun evi-eobp ()
  3097.   (< (- (point-max) (point)) 3))
  3098.  
  3099. (evi-defmotion horizontal evi-forward-word (&optional count context)
  3100.   "Move to the beginning of the COUNTth next word."
  3101.   (evi-forward-word-internal evi-word (or count 1) context))
  3102.  
  3103. (evi-defmotion horizontal evi-forward-Word (&optional count context)
  3104.   "Move to the beginning of the COUNTth next white-space delimited word."
  3105.   (evi-forward-word-internal evi-Word (or count 1) context))
  3106.  
  3107. (defun evi-forward-word-internal (pattern count context)
  3108.   (and (not context) (evi-eobp)
  3109.        (evi-error "End of buffer"))
  3110.   (if context
  3111.     (setq count (1- count)))
  3112.   (if (looking-at pattern)
  3113.     (setq count (1+ count)))
  3114.   (if (and (re-search-forward pattern nil 'limit count)
  3115.        (or (not (eq context 'to-next))
  3116.            (re-search-forward pattern
  3117.          (save-excursion (end-of-line) (point)) 'limit)))
  3118.     (if (eq context 'to-end)
  3119.       (if (or (> count 0) (looking-at pattern))
  3120.     (goto-char (match-end 0))
  3121.     (forward-char))
  3122.       (goto-char (match-beginning 0)))
  3123.     (if (eobp)
  3124.       (backward-char))))
  3125.  
  3126. (evi-defmotion horizontal evi-end-of-word (&optional count context)
  3127.   "Move to the end of the COUNTth next word."
  3128.   (evi-end-of-word-internal evi-word (or count 1) context))
  3129.  
  3130. (evi-defmotion horizontal evi-end-of-Word (&optional count context)
  3131.   "Move to the end of the COUNTth next whitespace delimited word."
  3132.   (evi-end-of-word-internal evi-Word (or count 1) context))
  3133.  
  3134. (defun evi-end-of-word-internal (pattern count context)
  3135.   (and (not context) (evi-eobp)
  3136.        (evi-error "End of buffer"))
  3137.   (or context
  3138.       (forward-char))
  3139.   (if (re-search-forward pattern nil 'limit count)
  3140.     (goto-char (- (match-end 0) (if context 0 1)))
  3141.     (if (eobp)
  3142.       (backward-char))))
  3143.  
  3144. (evi-defmotion horizontal evi-backward-word (&optional count context)
  3145.   "Move to the beginning of the COUNTth previous word."
  3146.   (evi-backward-word-internal evi-word (or count 1)))
  3147.  
  3148. (evi-defmotion horizontal evi-backward-Word (&optional count context)
  3149.   "Move to the beginning of the COUNTth previous whitespace delimited word."
  3150.   (evi-backward-word-internal evi-Word (or count 1)))
  3151.  
  3152. (defun evi-backward-word-internal (pattern count)
  3153.   (if (bobp)
  3154.     (evi-error "Beginning of buffer"))
  3155.   (evi-iterate count
  3156.     (if (re-search-backward pattern nil 'limit)
  3157.       (progn
  3158.     (looking-at pattern)
  3159.     (let ((end (match-end 0))
  3160.           (at-beginning nil))
  3161.       (while (and (looking-at pattern) (= (match-end 0) end)
  3162.               (not (setq at-beginning (bobp))))
  3163.         (backward-char))
  3164.       (if (not at-beginning)
  3165.         (forward-char))))
  3166.       (evi-break))))
  3167.  
  3168. (defconst evi-sentence-beginning "\\([.?!][]\"')]*\\([\t\n]\\| [ \t\n]\\)\\|^[ \t]*\n\\|\\`\\)[ \t\n]*[^ \t\n]")
  3169.  
  3170. (defconst evi-sentence-ending "\\([.?!][]\"')]*\\([\t\n]\\| [ \t\n]\\)\\|^[ \t]*$\\)")
  3171.  
  3172. (defconst evi-paragraph-beginning "\\(^\n\\|\\`\\)[ \t\n]*[^ \t\n]")
  3173. (defconst evi-paragraph-beginning-mod "\\(^[ \t]*\n\\|\\`\\)[ \t\n]*[^ \t\n]")
  3174.  
  3175. (defconst evi-paragraph-ending "[ \t\n]*[^ \t\n]\n$")
  3176. (defconst evi-paragraph-ending-mod "^[ \t]*$")
  3177.  
  3178. (defconst evi-section-beginning "^\\({\\|\\.\\(NH\\|SH\\|H\\|HU\\|nh\\|sh\\)[ \t\n]\\)")
  3179.  
  3180. (defconst evi-section-ending "[ \t\n]*\n\\(}\\|\\.\\(NH\\|SH\\|H\\|HU\\|nh\\|sh\\)[ \t\n]\\)")
  3181.  
  3182. (defun evi-not-at (pattern &optional limit)
  3183.   (let ((start (point)))
  3184.     (if (re-search-backward pattern limit 'limit)
  3185.       (prog1
  3186.     (/= (match-end 0) start)
  3187.     (goto-char start))
  3188.       t)))
  3189.  
  3190. (evi-defmotion horizontal evi-forward-sentence (&optional count context)
  3191.   "Move to the beginning of the COUNT'th next sentence."
  3192.   (and (not context) (evi-eobp)
  3193.        (evi-error "End of buffer"))
  3194.   (forward-char)
  3195.   (and (eq context 'to-next) (evi-not-at evi-sentence-beginning)
  3196.        (setq context 'to-end))
  3197.   (if (re-search-forward evi-sentence-beginning nil 'limit
  3198.              (- (or count 1) (if context 1 0)))
  3199.     (if context
  3200.       (if (eq context 'to-end)
  3201.     (if (re-search-forward evi-sentence-ending nil 'limit)
  3202.       (skip-chars-backward " \t\n"))
  3203.     (if (re-search-forward evi-sentence-beginning
  3204.           (save-excursion
  3205.         (re-search-forward evi-paragraph-ending nil 'limit)
  3206.         (1- (match-beginning 0)))
  3207.           'limit)
  3208.       (backward-char)))
  3209.       (backward-char))))
  3210.  
  3211. (evi-defmotion horizontal evi-backward-sentence (&optional count context)
  3212.   "Move to the beginning of the COUNT'th previous sentence."
  3213.   (if (bobp)
  3214.     (evi-error "Beginning of buffer"))
  3215.   (skip-chars-backward " \t\n")
  3216.   (if (re-search-backward evi-sentence-beginning nil 'limit (or count 1))
  3217.     (goto-char (1- (match-end 0)))))
  3218.  
  3219. (evi-defmotion horizontal evi-forward-paragraph (&optional count context)
  3220.   "Move to the beginning of the COUNT'th next paragraph."
  3221.   (and (not context) (evi-eobp)
  3222.        (evi-error "End of buffer"))
  3223.   (if evi-modified-paragraph
  3224.       (progn
  3225.     (forward-char)
  3226.     (and (eq context 'to-next) (evi-not-at evi-paragraph-beginning-mod)
  3227.          (setq context 'to-end))
  3228.     (if (re-search-forward evi-paragraph-beginning-mod nil 'limit
  3229.                    (- (or count 1) (if (eq context 'to-end) 1 0)))
  3230.         (if (eq context 'to-end)
  3231.         (if (re-search-forward evi-paragraph-ending-mod nil 'limit)
  3232.             (goto-char (1- (match-beginning 0))))
  3233.           (if context
  3234.           (beginning-of-line))
  3235.           (backward-char))))
  3236.     (if (re-search-forward evi-paragraph-ending nil 'limit (or count 1))
  3237.     (goto-char (match-end 0)))
  3238.     (if (eq context 'to-next)
  3239.     (backward-char))))
  3240.  
  3241. (evi-defmotion horizontal evi-backward-paragraph (&optional count context)
  3242.   "Move to the beginning of the COUNT'th previous paragraph."
  3243.   (if (bobp)
  3244.     (evi-error "Beginning of buffer"))
  3245.   (if evi-modified-paragraph
  3246.       (if (re-search-backward evi-paragraph-beginning-mod
  3247.                   nil 'limit (or count 1))
  3248.       (goto-char (1- (match-end 0))))
  3249.     (and (eq context 'to-next) (bolp) (not (bobp))
  3250.      (setq evi-mark (1- evi-mark)))
  3251.     (if (re-search-backward evi-paragraph-beginning nil 'limit (or count 1))
  3252.     (goto-char (match-beginning 0)))))
  3253.  
  3254. (evi-defmotion horizontal evi-forward-section (&optional count context)
  3255.   "Move to the beginning of the COUNT'th next section."
  3256.   (and (not context) (evi-eobp)
  3257.        (evi-error "End of buffer"))
  3258.   (or context
  3259.       (evi-push-context (point)))
  3260.   (let ((start (point)))
  3261.     (skip-chars-forward "^ \t\n")
  3262.     (or (eobp)
  3263.     (forward-char))
  3264.     (and (eq context 'to-next) (evi-not-at evi-section-beginning start)
  3265.      (setq context 'to-end)))
  3266.   (if (re-search-forward evi-section-beginning nil 'limit
  3267.              (- (or count 1) (if (eq context 'to-end) 1 0)))
  3268.     (if (eq context 'to-end)
  3269.     (if (re-search-forward evi-section-ending nil 'limit)
  3270.       (or (eq (preceding-char) ?})
  3271.           (goto-char (match-beginning 0))))
  3272.       (goto-char (match-beginning 0))
  3273.       (if context
  3274.     (backward-char)))))
  3275.  
  3276. (evi-defmotion horizontal evi-backward-section (&optional count context)
  3277.   "Move to the beginning of the COUNT'th previous section."
  3278.   (if (bobp)
  3279.     (evi-error "Beginning of buffer"))
  3280.   (or context
  3281.       (evi-push-context (point)))
  3282.   (re-search-backward evi-section-beginning nil 'limit (or count 1)))
  3283.  
  3284. (defun evi-region-arbitrary ()
  3285.   "Define region bounded by mark and point (containing point)."
  3286.   (interactive)
  3287.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  3288.   (forward-char)
  3289.   (setq evi-region-shape 'chars))
  3290.  
  3291. (defun evi-region-mouse ()
  3292.   "Define region bounded by last mouse selection."
  3293.   (interactive)
  3294.   (setq evi-mark (mark))
  3295.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  3296.   (forward-char)
  3297.   (setq evi-region-shape 'chars))
  3298.  
  3299. (defun evi-region-rectangle ()
  3300.   "Define region as rectangle bounded by mark and point (containing point)."
  3301.   (interactive)
  3302.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  3303.   (setq evi-region-shape 'rectangle))
  3304.  
  3305. (defun evi-region-rows (context)
  3306.   "Define region as rows bounded by mark and point (containing point)."
  3307.   (interactive (evi-context-arg))
  3308.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  3309.   (evi-expand-region-to-lines evi-context))
  3310.  
  3311. ;ZZ - very naive
  3312. (defun evi-region-columns ()
  3313.   "Define region as columns bounded by mark and point (containing point)."
  3314.   (interactive)
  3315.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  3316.   (let ((start-col (save-excursion (goto-char evi-mark) (current-column)))
  3317.     (end-col (current-column)))
  3318.     (setq evi-mark start-col)
  3319.     (goto-char (point-max))
  3320.     (if (eolp)
  3321.     (backward-char))
  3322.     (beginning-of-line)
  3323.     (goto-char (+ (point) end-col)))
  3324.   (setq evi-region-shape 'rectangle))
  3325.  
  3326. ;; Searching
  3327.  
  3328. (evi-defmotion horizontal evi-search-forward
  3329.   (&string "/" string &optional count context)
  3330.   "Search forward for the ARGth occurence of a pattern.  A null string will
  3331. repeat the previous search."
  3332.   (evi-do-vi-search t string (or count 1)))
  3333.  
  3334. (evi-defmotion horizontal evi-search-backward
  3335.   (&string "?" string &optional count context)
  3336.   "Search backward for the ARGth occurence of a pattern.  A null string will
  3337. repeat the previous search."
  3338.   (evi-do-vi-search nil string (or count 1)))
  3339.  
  3340. (defun evi-do-vi-search (search-forward search-spec count)
  3341.   (let ((ex-user-buffer (current-buffer)))
  3342.     (set-buffer ex-work-space)
  3343.     (erase-buffer)
  3344.     (insert (if search-forward ?/ ??) search-spec "\n")
  3345.     (goto-char (point-min))
  3346.     (let ((string (ex-scan-regular-expression))
  3347.       (offset (ex-scan-line-offset)))
  3348.       (set-buffer ex-user-buffer)
  3349.       (or (string= string "")
  3350.       (setq evi-search-pattern string))
  3351.       (if evi-search-pattern
  3352.       (evi-do-search (setq evi-search-forward search-forward)
  3353.              evi-search-pattern count)
  3354.     (evi-error "No previous search pattern"))
  3355.       (if (> offset 0)
  3356.       (evi-next-line-internal offset)
  3357.     (if (< offset 0)
  3358.         (evi-previous-line-internal (- offset)))))))
  3359.  
  3360. (evi-defmotion horizontal evi-search-next (&optional count context)
  3361.   "Search for the next ARGth occurence of the previous search pattern."
  3362.   (if evi-search-pattern
  3363.     (evi-do-search evi-search-forward evi-search-pattern (or count 1))
  3364.     (evi-error "No previous search pattern")))
  3365.  
  3366. (evi-defmotion horizontal evi-search-next-reverse (&optional count context)
  3367.   "Search for the next ARGth occurence of the previous search pattern
  3368. but look in the opposite direction."
  3369.   (let ((evi-search-forward (not evi-search-forward)))
  3370.     (do-evi-search-next count context)))
  3371.  
  3372. (defun evi-do-search (search-forward search-string count)
  3373.   (let ((case-fold-search evi-ignore-case)
  3374.     (starting-point (point)))
  3375.     (if (if search-forward
  3376.       (evi-search-forward-count search-string count)
  3377.       (evi-search-backward-count search-string count))
  3378.       (progn
  3379.     ; ZZ if we know the search didn't take us far, perhaps we shouldn't
  3380.     ; push a context...
  3381.     (evi-push-context starting-point)
  3382.         (goto-char (match-beginning 0)))
  3383.       (progn
  3384.     (goto-char starting-point)
  3385.     (evi-error
  3386.       (concat
  3387.         (if (> count 1) "Nth occurrence not found" "Pattern not found")
  3388.         (if evi-search-wraparound ""
  3389.           (if search-forward
  3390.           " before end of file"
  3391.           " before beginning of file"))))))))
  3392.  
  3393. ; ZZ use evi-iterate
  3394. (defun evi-search-forward-count (string count)
  3395.   (if (> count 0)
  3396.     (progn (forward-char)
  3397.        (if (re-search-forward string nil t)
  3398.          (evi-search-forward-count string (1- count))
  3399.          (if evi-search-wraparound
  3400.            (progn (goto-char (point-min))
  3401.               (if (re-search-forward string nil t)
  3402.             (evi-search-forward-count string (1- count)))))))
  3403.     t))
  3404.  
  3405. (defun evi-search-backward-count (string count)
  3406.   (if (> count 0)
  3407.     (if (re-search-backward string nil t)
  3408.       (evi-search-backward-count string (1- count))
  3409.       (if evi-search-wraparound
  3410.     (progn (goto-char (point-max))
  3411.            (if (re-search-backward string nil t)
  3412.          (evi-search-backward-count string (1- count))))))
  3413.     t))
  3414.  
  3415. (evi-defmotion horizontal evi-find-character (&char char &optional count context)
  3416.   "Search for CHAR on the current line.  With COUNT find the COUNT'th occurance."
  3417.   (setq evi-find-character char
  3418.     evi-find-forward t
  3419.     evi-find-up-to nil)
  3420.   (evi-find-character-internal (or count 1) context))
  3421.  
  3422. (evi-defmotion horizontal evi-find-char-backwards
  3423.   (&char char &optional count context)
  3424.   "Search backwards for CHAR on the current line.  With COUNT find the
  3425. COUNT'th occurance."
  3426.   (setq evi-find-character char
  3427.     evi-find-forward nil
  3428.     evi-find-up-to nil)
  3429.   (evi-find-character-backwards-internal (or count 1) context))
  3430.  
  3431. (evi-defmotion horizontal evi-find-character-before
  3432.   (&char char &optional count context)
  3433.   "Search for CHAR on the current line and leave the cursor on the character
  3434. before it.  With COUNT find the COUNT'th occurance."
  3435.   (setq evi-find-character char
  3436.     evi-find-forward t
  3437.     evi-find-up-to t)
  3438.   (evi-find-character-internal (or count 1) context))
  3439.  
  3440. (evi-defmotion horizontal evi-find-char-backwards-after
  3441.   (&char char &optional count context)
  3442.   "Search backwards for CHAR on the current line and leave the cursor on
  3443. the character after it.  With COUNT find the COUNT'th occurance."
  3444.   (setq evi-find-character char
  3445.     evi-find-forward nil
  3446.     evi-find-up-to t)
  3447.   (evi-find-character-backwards-internal (or count 1) context))
  3448.  
  3449. (evi-defmotion horizontal evi-find-next-character (&optional count context)
  3450.   "Search for the next COUNT'th occurence of the previous search character."
  3451.   (if evi-find-character
  3452.     (if evi-find-forward
  3453.       (evi-find-character-internal (or count 1) context)
  3454.       (evi-find-character-backwards-internal (or count 1) context))
  3455.     (evi-error "No previous search character")))
  3456.  
  3457. (evi-defmotion horizontal evi-find-next-character-reverse (&optional count context)
  3458.   "Search for the next COUNT'th occurence of the previous search character
  3459. in the opposite direction."
  3460.   (let ((evi-find-forward (not evi-find-forward)))
  3461.     (do-evi-find-next-character count context)))
  3462.  
  3463. (defun evi-find-character-internal (count context)
  3464.   (if (or (not (bolp)) (not (eolp)))
  3465.       (forward-char))
  3466.   (let ((case-fold-search nil))
  3467.     (if (search-forward (char-to-string evi-find-character)
  3468.             (save-excursion (end-of-line) (point)) t count)
  3469.       (if evi-find-up-to
  3470.     (backward-char))
  3471.       (progn (if (or (not (bolp)) (not (eolp))) (backward-char))
  3472.          (evi-error "No more occurences on this line"))))
  3473.   (or context
  3474.       (backward-char)))
  3475.  
  3476. (defun evi-find-character-backwards-internal (count context)
  3477.   (let ((case-fold-search nil))
  3478.     (or (search-backward (char-to-string evi-find-character)
  3479.              (save-excursion (beginning-of-line) (point)) t count)
  3480.     (evi-error "No more occurences on this line")))
  3481.   (if evi-find-up-to
  3482.     (forward-char)))
  3483.  
  3484. (defun evi-modify-paren-syntax (char)
  3485.   (let ((i 0)
  3486.     (open t)
  3487.     (match-open nil)
  3488.     (len (length evi-parens)))
  3489.     (while (< i len)
  3490.       (if (= char (aref evi-parens i))
  3491.       (if open
  3492.           (progn
  3493.         (setq match-open t)
  3494.         (modify-syntax-entry char
  3495.                      (concat "(" (substring evi-parens i (1+ i))))
  3496.         (modify-syntax-entry (aref evi-parens (1+ i))
  3497.                      (concat ")" (char-to-string char)))
  3498.         (setq i (+ 2 i)))
  3499.         (setq match-open nil)
  3500.         (modify-syntax-entry char
  3501.                  (concat ")" (substring evi-parens (1- i) i)))
  3502.         (modify-syntax-entry (aref evi-parens (1- i))
  3503.                  (concat "(" (char-to-string char)))
  3504.         (setq i (1+ i)))
  3505.     (modify-syntax-entry (aref evi-parens i) ".")
  3506.     (setq i (1+ i)
  3507.           open (not open))))
  3508.     match-open))
  3509.  
  3510. (evi-defmotion horizontal evi-paren-match (&optional count context)
  3511.   "Move cursor to matching parenthesis, brace or bracket."
  3512.   (let ((end-point (save-excursion (end-of-line) (point))))
  3513.     (if (re-search-forward evi-parens-match end-point t)
  3514.     (progn (backward-char)
  3515.            (let* ((st (syntax-table))
  3516.               (newst (copy-syntax-table st)))
  3517.          (set-syntax-table newst)
  3518.          (if (evi-modify-paren-syntax (following-char))
  3519.              (progn (forward-sexp 1)
  3520.                 (or context (backward-char)))
  3521.            (forward-char)
  3522.            (if context (setq evi-mark (1+ evi-mark)))
  3523.            (backward-sexp 1))
  3524.          (set-syntax-table st)))
  3525.       (evi-error "Nothing on rest of line to balance"))))
  3526.  
  3527. ;; Repeating
  3528.  
  3529. (defun evi-add-key (k)
  3530.   (if (>= evi-command-keys-index evi-command-keys-length)
  3531.       (progn (setq evi-command-keys-length (+ evi-command-keys-length 256)
  3532.            evi-command-keys (concat evi-command-keys
  3533.                         (make-string 256 0)))))
  3534.   (aset evi-command-keys evi-command-keys-index k)
  3535.   (setq evi-command-keys-index (1+ evi-command-keys-index)
  3536.     evi-prompt (concat evi-prompt (char-to-string k))))
  3537.  
  3538. (defun evi-lose-key (&optional count)
  3539.   (if (> evi-command-keys-index 0)
  3540.       (setq evi-command-keys-index (- evi-command-keys-index (or count 1)))))
  3541.  
  3542. (defun evi-erase-keys ()
  3543.   (setq evi-command-keys-index 0
  3544.     evi-prompt nil))
  3545.  
  3546. (defun evi-copy-keys ()
  3547.   (substring evi-command-keys 0 evi-command-keys-index))
  3548.  
  3549. (defun evi-keys-description ()
  3550.   (mapconcat 'single-key-description (evi-copy-keys) ""))
  3551.  
  3552. (defun evi-prompt-keys-description ()
  3553.   (mapconcat 'single-key-description evi-prompt ""))
  3554.  
  3555. (defun evi-save-command-keys ()
  3556.   (setq evi-last-command-keys (evi-copy-keys)
  3557.     evi-last-prefix-count evi-prefix-count
  3558.     evi-hidden-repeat-count 0
  3559.     evi-last-register-spec evi-register-spec))
  3560.  
  3561. (defun evi-repeat ()
  3562.   "Repeat last modifying command."
  3563.   (interactive)
  3564.   (if evi-prefix-count
  3565.       (setq evi-last-prefix-count evi-prefix-count)
  3566.     (setq evi-prefix-count evi-last-prefix-count))
  3567.   (if evi-register-spec
  3568.       (setq evi-last-register-spec evi-register-spec)
  3569.     (setq evi-register-spec evi-last-register-spec))
  3570.   (setq evi-repeat-count (1+ evi-hidden-repeat-count))
  3571.   (evi-push-continuation 'evi-repeat-continuation)
  3572.   (evi-push-macro evi-last-command-keys
  3573.           'evi-repeat-after evi-last-command-keys))
  3574.  
  3575. (defun evi-repeat-continuation ()
  3576.   )
  3577.  
  3578. (defun evi-repeat-after (command-keys)
  3579.   (setq evi-last-command-keys command-keys
  3580.     evi-hidden-repeat-count evi-repeat-count
  3581.     evi-repeat-count 0))
  3582.  
  3583. (defun evi-prompt-repeat ()
  3584.   "Print last modifying command."
  3585.   (interactive)
  3586.   (let ((command (evi-read-string "Repeat: " evi-last-command-keys)))
  3587.     (evi-execute-macro command)
  3588.     (setq evi-last-command-keys command)))
  3589.  
  3590. ;; Prefix counts
  3591.  
  3592. ; ZZ used in evi-window-control!
  3593. ; ZZ need to rewrite that...
  3594. (defun evi-read-number (prefix-value)
  3595.   (let ((char (evi-read-command-char)))
  3596.     (if (and (>= char ?0) (<= char ?9))
  3597.       (evi-read-number (+ (* prefix-value 10) (- char ?0)))
  3598.       (progn (evi-unread-command-char char)
  3599.          prefix-value))))
  3600.  
  3601. (defun evi-prefix-digit ()
  3602.   "Prefix count."
  3603.   (interactive)
  3604.   ;; prefixes aren't a part of the command-keys
  3605.   (evi-lose-key)
  3606.   (setq evi-prefix-count (+ (* (or evi-prefix-count 0) 10)
  3607.                 (- last-command-char ?0)))
  3608.   (evi-push-continuation 'evi-prompt))
  3609.  
  3610. (defun evi-digit-or-beginning-of-line ()
  3611.   (interactive)
  3612.   (if evi-prefix-count
  3613.       (evi-prefix-digit)
  3614.     (evi-beginning-of-line)))
  3615.  
  3616. (defun evi-adjust-count ()
  3617.   (if evi-prefix-count-multiplier
  3618.       (setq evi-prefix-count (* (or evi-prefix-count 1)
  3619.                 evi-prefix-count-multiplier))
  3620.     evi-prefix-count))
  3621.  
  3622. ;; Registers
  3623.  
  3624. (defun evi-prefix-register ()
  3625.   "Prefix register."
  3626.   (interactive)
  3627.   ;; registers aren't a part of the command-keys
  3628.   (evi-lose-key)
  3629.   (evi-prompt)
  3630.   (let* ((char (evi-read-command-char)))
  3631.     (evi-lose-key)
  3632.     (setq evi-register-spec (cons (evi-register-number char)
  3633.                   (not (and (>= char ?a) (<= char ?z))))))
  3634.   (evi-push-continuation 'evi-prompt))
  3635.  
  3636. (defun evi-register-number (register-name)
  3637.   (cond ((and (>= register-name ?a) (<= register-name ?z))
  3638.       (+ (- register-name ?a) 10))
  3639.     ((and (>= register-name ?A) (<= register-name ?Z))
  3640.       (+ (- register-name ?A) 10))
  3641.     ((and (>= register-name ?1) (<= register-name ?9))
  3642.      (% (+ evi-digit-register (- register-name ?0) evi-repeat-count) 9))
  3643.     ((eq register-name ?^)
  3644.       evi-register-unnamed)
  3645.     ((eq register-name ?@)
  3646.       (or evi-last-macro-register
  3647.           (evi-error "No previous macro register specified")))
  3648.     (t (evi-error "Invalid register name"))))
  3649.  
  3650. (defun evi-register-name (register-number)
  3651.   (if (> register-number 9)
  3652.     (+ register-number (- ?a 10))
  3653.     (+ register-number ?1)))
  3654.  
  3655. (defun evi-copy-region-to-registers (number-register-also)
  3656.   (let ((region (if (eq evi-region-shape 'rectangle)
  3657.             (extract-rectangle evi-mark (1+ (point)))
  3658.           (buffer-substring evi-mark (point)))))
  3659.     (evi-copy-region-to-register region evi-register-spec)
  3660.     (if number-register-also
  3661.       (progn (aset evi-registers
  3662.            evi-digit-register (cons region evi-region-shape))
  3663.          (setq evi-digit-register (if (= evi-digit-register 0)
  3664.                       8
  3665.                     (1- evi-digit-register)))))))
  3666.  
  3667. (defun evi-copy-region-to-register (region register-spec)
  3668.   (let ((register-number (car register-spec)))
  3669.     (if (not (eq register-number evi-register-unnamed))
  3670.     (aset evi-registers
  3671.           evi-register-unnamed (cons region evi-region-shape)))
  3672.     (if register-spec
  3673.     (aset evi-registers register-number
  3674.           (if (and (cdr register-spec)
  3675.                (not (eq evi-region-shape 'rectangle)))
  3676.           (let ((register (aref evi-registers register-number)))
  3677.             (cons (concat (car register) region) (cdr register)))
  3678.         (cons region evi-region-shape))))))
  3679.  
  3680. (defun evi-register-string (count)
  3681.   (interactive (evi-count-arg))
  3682.   (evi-extend-continuation 'evi-register-string-after count)
  3683.   (evi-read-string "\""))
  3684.  
  3685. (defun evi-register-string-after (count)
  3686.   (setq evi-region-shape 'chars)
  3687.   (evi-copy-region-to-register evi-minibuf-contents
  3688.     (or evi-register-spec (cons evi-register-unnamed nil))))
  3689.  
  3690. (defun evi-register-char (char &optional count)
  3691.   (interactive (evi-character-arg))
  3692.   (evi-register-string (char-to-string char)))
  3693.  
  3694. (defun evi-buffer-name ()
  3695.   (interactive)
  3696.   (evi-register-string (buffer-name)))
  3697.  
  3698. ;; Undoing
  3699.  
  3700. (defun evi-undo ()
  3701.   "Undo previous change."
  3702.   (interactive)
  3703.   ; ZZ - is this the only place we're concerned with unnecessary output
  3704.   ; during a macro?
  3705.   (or evi-current-macro evi-in-minibuf
  3706.       (message "undo!"))
  3707.   (evi-undo-start)
  3708.   (evi-undo-one-change)
  3709.   (evi-fixup-cursor 'vertical))
  3710.  
  3711. (defun evi-undo-line ()
  3712.   "Undo all changes to this line."
  3713.   (interactive)
  3714.   (evi-undo-start)
  3715.   (evi-undo-one-line)
  3716.   (evi-fixup-cursor 'vertical))
  3717.  
  3718. (defun evi-undo-start ()
  3719.   (undo-start)
  3720.   (if (boundp 'buffer-undo-list)
  3721.       ; if the first record is a boundary, skip it
  3722.       (while (and pending-undo-list (null (car pending-undo-list)))
  3723.     (setq pending-undo-list (cdr pending-undo-list)))
  3724.     (undo-more 1)))
  3725.  
  3726. (defun evi-undo-more ()
  3727.   "Continue undoing previous changes."
  3728.   (interactive)
  3729.   (if (boundp 'buffer-undo-list)
  3730.       (if (boundp 'pending-undo-list)
  3731.       (progn (or evi-current-macro evi-in-minibuf
  3732.              (message "undo more!"))
  3733.          (evi-undo-one-change))
  3734.     (evi-error "No previous undo to continue"))
  3735.     (or evi-current-macro evi-in-minibuf
  3736.     (message "undo more!"))
  3737.     (evi-undo-one-change))
  3738.   (evi-fixup-cursor 'vertical))
  3739.  
  3740. (defun evi-undo-one-change ()
  3741.   (let ((modified (buffer-modified-p)))
  3742.     (undo-more 1)
  3743.     (and modified (not (buffer-modified-p))
  3744.      (delete-auto-save-file-if-necessary)))
  3745.   (evi-reset-goal-column))
  3746.  
  3747. (defvar evi-last-undo-line-mark nil)
  3748.  
  3749. ;; ZZ out-of-date
  3750. (if (boundp 'buffer-undo-list)
  3751.     ; undo records are:
  3752.     ;   (t . ...) which marks a file save
  3753.     ;   ("string" . pos) which undoes a delete
  3754.     ;   (pos . pos) which undoes an insert
  3755.     (defun evi-undo-one-line ()
  3756.       (if (eq evi-last-undo-line-mark (cdr buffer-undo-list))
  3757.     (evi-error "No undo for this line"))
  3758.       (let* ((begin (save-excursion (beginning-of-line) (point)))
  3759.          (end (save-excursion (end-of-line) (point)))
  3760.          (undo-new nil)
  3761.          (something-to-do nil))
  3762.     (evi-enumerate-condition undo-record pending-undo-list
  3763.       (cond ((eq (car undo-record) t)
  3764.           (setq undo-new (nconc undo-new list))
  3765.           nil)
  3766.         ((stringp (car undo-record))
  3767.           (if (and (>= (cdr undo-record) begin)
  3768.                (<= (cdr undo-record) end))
  3769.             (progn (setq end (+ end (length (car undo-record))))
  3770.                (setq undo-new
  3771.                  (nconc undo-new (list undo-record)))
  3772.                (setq something-to-do t)
  3773.                t)
  3774.             (progn (setq undo-new (nconc undo-new (list nil) list))
  3775.                nil)))
  3776.         ((integerp (car undo-record))
  3777.           (let* ((first (car undo-record))
  3778.              (second (cdr undo-record))
  3779.              (begin2 (if (< first begin) begin first))
  3780.              (end2 (if (> second end) end second))
  3781.              (diff (- end2 begin2)))
  3782.             (if (and (<= first end) (>= second begin) (/= begin2 end2))
  3783.               (progn
  3784.             (setq undo-new
  3785.                   (nconc undo-new (list (cons begin2 end2))))
  3786.             (setq something-to-do t)
  3787.             (if (or (< first begin) (> second end))
  3788.               (progn
  3789.                 (nconc undo-new (list nil))
  3790.                 (if (< first begin)
  3791.                   (nconc undo-new (list (cons first begin))))
  3792.                 (if (> second end)
  3793.                   (nconc undo-new
  3794.                 (list (cons (- end diff) (- second diff)))))
  3795.                 (nconc undo-new (cdr list))
  3796.                 nil)
  3797.               (progn (setq end (- end diff))
  3798.                  t)))
  3799.               (progn
  3800.                  (setq undo-new (nconc undo-new (list nil) list))
  3801.                  nil))))
  3802.         ((eq undo-record nil)
  3803.           t)))
  3804.     (if something-to-do
  3805.       (let ((modified (buffer-modified-p)))
  3806.         (setq pending-undo-list undo-new)
  3807.         (undo-more 1)
  3808.         (or evi-current-macro evi-in-minibuf
  3809.         (message "Undo!"))
  3810.         (setq evi-last-undo-line-mark buffer-undo-list)
  3811.         (beginning-of-line)
  3812.         (and modified (not (buffer-modified-p))
  3813.          (delete-auto-save-file-if-necessary)))
  3814.       (evi-error "No undo for this line")))
  3815.       (evi-reset-goal-column)))
  3816.  
  3817. (defun evi-change-last-undo (pos char)
  3818.   (let ((ul buffer-undo-list))
  3819.     (while (and (listp (car ul)) (null (car (car ul))))
  3820.       (setq ul (cdr ul)))
  3821.     (aset (car (car ul)) pos char)))
  3822.  
  3823. (defun evi-undo-boundary ()
  3824.   (or (eq evi-emacs-version 'emacs18)
  3825.       (setq buffer-undo-list (cons nil buffer-undo-list))))
  3826.  
  3827. (defun evi-kill-undo-boundary ()
  3828.   (and buffer-undo-list (null (car buffer-undo-list))
  3829.       (setq buffer-undo-list (cdr buffer-undo-list))))
  3830.  
  3831. ;; Marks
  3832.  
  3833. (defun evi-set-mark (char &optional count)
  3834.   "Mark location."
  3835.   (interactive (evi-character-arg))
  3836.   (cond ((and (>= char ?a) (<= char ?z))
  3837.       (aset evi-registers (+ (- char ?a) 36) (point-marker)))
  3838.     ((eq char ?.)
  3839.       (setq evi-mark (point)))))
  3840.  
  3841. (evi-defmotion horizontal evi-goto-mark-horizontal (&optional count context)
  3842.   "Goto a mark."
  3843.   (evi-goto-mark-internal (evi-read-command-char) context))
  3844.  
  3845. (evi-defmotion vertical evi-goto-mark-vertical (&optional count context)
  3846.   "Goto a mark.  If an operand, define a whole lines region."
  3847.   (evi-goto-mark-internal (evi-read-command-char) context)
  3848.   (or context
  3849.     (back-to-indentation)))
  3850.  
  3851. (defun evi-goto-mark-internal (char &optional context)
  3852.   (cond ((and (>= char ?a) (<= char ?z))
  3853.       (let ((marker (aref evi-registers (+ (- char ?a) 36))))
  3854.         (if (not (eq (current-buffer) (marker-buffer marker)))
  3855.           (progn (switch-to-buffer (marker-buffer marker))
  3856.              ; unpleasant, but best we can do... (?)
  3857.              (if context (setq evi-mark (point)))))
  3858.         (evi-push-context)
  3859.         (goto-char marker)))
  3860.     ((or (eq char ?`) (eq char ?'))
  3861.       (goto-char (evi-exchange-context)))
  3862.     ((eq char ?.)
  3863.       (goto-char (evi-pop-context)))
  3864.     ((eq char ?,)
  3865.       (goto-char (evi-unpop-context)))))
  3866.  
  3867. (defun evi-push-context (&optional offset)
  3868.   (let ((marker (if offset (set-marker (make-marker) offset) (point-marker))))
  3869.     (aset evi-context-ring evi-context-ring-cursor marker)
  3870.     (setq evi-context-ring-cursor
  3871.       (if (= evi-context-ring-cursor 9) 0 (1+ evi-context-ring-cursor)))))
  3872.  
  3873. (defun evi-pop-context ()
  3874.   (setq evi-context-ring-cursor
  3875.     (if (= evi-context-ring-cursor 0) 9 (1- evi-context-ring-cursor)))
  3876.   (aref evi-context-ring evi-context-ring-cursor))
  3877.  
  3878. (defun evi-unpop-context ()
  3879.   (setq evi-context-ring-cursor
  3880.     (if (= evi-context-ring-cursor 9) 0 (1+ evi-context-ring-cursor)))
  3881.   (aref evi-context-ring evi-context-ring-cursor))
  3882.  
  3883. (defun evi-exchange-context ()
  3884.   (let ((cursor
  3885.      (if (= evi-context-ring-cursor 0) 9 (1- evi-context-ring-cursor))))
  3886.     (prog1 (aref evi-context-ring cursor)
  3887.        (aset evi-context-ring cursor (point-marker)))))
  3888.  
  3889. ;; Misc
  3890.  
  3891. (defun evi-redraw ()
  3892.   "Redraw the display."
  3893.   (interactive)
  3894.   (cond ((eq evi-emacs-version 'emacs18)
  3895.       (redraw-display))
  3896.     ((eq evi-emacs-version 'emacs19)
  3897.       (if window-system
  3898.           (redraw-frame (selected-frame))
  3899.         (redraw-display)))
  3900.     ((eq evi-emacs-version 'lucid19)
  3901.       (redraw-screen (selected-screen)))))
  3902.  
  3903. (defun evi-file-info ()
  3904.   "Give information on the file associated with the current buffer."
  3905.   (interactive)
  3906.   (let* ((line-number (count-lines 1 (min (1+ (point)) (point-max))))
  3907.      (total-lines (1- (+ line-number (count-lines (point) (point-max)))))
  3908.      (file-name buffer-file-name))
  3909.     (message "%s%s%s line %d of %d, column %d --%d%%--"
  3910.          (if file-name
  3911.          (concat "\""
  3912.              (if evi-global-directory
  3913.                  (evi-abbreviate-file-name file-name
  3914.                                (evi-current-directory))
  3915.                file-name)
  3916.              "\"")
  3917.            "No file")
  3918.          (if evi-buffer-read-only
  3919.            " [Read only]" "")
  3920.          (if (buffer-modified-p) " [Modified]" "")
  3921.          (if (<= line-number 0) 1 line-number)
  3922.          (if (< total-lines 0) 1 total-lines)
  3923.          (1+ (current-column))
  3924.          (if (< total-lines 0)
  3925.          100
  3926.            (/ (* line-number 100) total-lines)))))
  3927.  
  3928. (defun evi-abbreviate-file-name (file-name directory &optional abbrev)
  3929.   (let* ((length (length directory))
  3930.      (ends-in-slash (= (aref directory (1- length)) ?/)))
  3931.     (if (and (> length 0)
  3932.          (>= (length file-name) length)
  3933.          (string= (substring file-name 0 length) directory))
  3934.       (concat (or abbrev "")
  3935.           (substring file-name
  3936.              (+ length (if (or abbrev ends-in-slash) 0 1))))
  3937.       file-name)))
  3938.  
  3939. (defun evi-tag ()
  3940.   "Go to the tag which is the next word in the buffer."
  3941.   (interactive)
  3942.   (evi-motion-command 'do-evi-forward-word 'horizontal 1 'to-end)
  3943.   (ex-tag (buffer-substring evi-mark (point))))
  3944.  
  3945. (defun evi-make-char-table ()
  3946.   (let ((table (make-vector 256 0))
  3947.     (i ?:))
  3948.     (while (<= ?0 (setq i (1- i)))
  3949.       (aset table i 1))
  3950.     (setq i ?\[)
  3951.     (while (<= ?A (setq i (1- i)))
  3952.       (aset table i 2))
  3953.     (setq i ?\{)
  3954.     (while (<= ?a (setq i (1- i)))
  3955.       (aset table i 2))
  3956.     (setq i ? )
  3957.     (while (<= 0 (setq i (1- i)))
  3958.       (aset table i 4))
  3959.     table))
  3960.  
  3961. (defvar evi-char-table (evi-make-char-table))
  3962.  
  3963. (defun evi-is-num (c)
  3964.   (= (logand (aref evi-char-table c) 1) 1))
  3965.  
  3966. (defun evi-is-alpha (c)
  3967.   (= (logand (aref evi-char-table c) 2) 2))
  3968.  
  3969. (defun evi-is-alphanum (c)
  3970.   (/= (logand (aref evi-char-table c) 3) 0))
  3971.  
  3972. (defun evi-is-nonalphanum (c)
  3973.   (= (logand (aref evi-char-table c) 3) 0))
  3974.  
  3975. (defun evi-is-control-char (c)
  3976.   (= (logand (aref evi-char-table c) 4) 4))
  3977.  
  3978. (defun evi-is-printable (c)
  3979.   (and (not (evi-is-control-char c))
  3980.        (< c ?\C-?)))
  3981.  
  3982. ;; Display of lists
  3983.  
  3984. (defun evi-display-and-prompt (command &optional args)
  3985.   (let ((window (selected-window))
  3986.     (wconf (current-window-configuration)))
  3987.     ;; this is for lucid19
  3988.     (if (eq window (minibuffer-window))
  3989.     (select-window (previous-window)))
  3990.     (if (apply command args)
  3991.     (progn
  3992.       (select-window (minibuffer-window))
  3993.       (message
  3994.         "Hit SPACE or RET to continue, anything else to keep window")
  3995.       (let ((c (evi-read-char)))
  3996.         (if (or (= c ?\n) (= c ?\r) (= c ? ))
  3997.         (set-window-configuration wconf)
  3998.           (select-window window)))))))
  3999.  
  4000. (defun evi-display-list-and-prompt (buffer list &optional initial max-len)
  4001.   (evi-display-and-prompt
  4002.    'evi-display-list (list buffer list initial max-len)))
  4003.  
  4004. (defun evi-display-list (buffer list &optional initial max-len)
  4005.   (save-excursion
  4006.     (set-buffer (get-buffer-create buffer))
  4007.     (erase-buffer)
  4008.     (evi)
  4009.     (if initial
  4010.     (insert initial))
  4011.     (if (eq max-len 'half)
  4012.     (setq max-len (- (/ (window-width) 2) 2)))
  4013.     (if list
  4014.     (evi-insert-list-pretty list (or max-len (- (window-width) 2))))
  4015.     (goto-char (point-min))
  4016.     (display-buffer buffer t))
  4017.   ;; indicates to evi-display-and-prompt that something was displayed
  4018.   t)
  4019.  
  4020. (defun evi-insert-list-pretty (list max-len)
  4021.   (let* ((len (length list))
  4022.      (max-width (min (evi-max-len list) max-len))
  4023.      (col-width (+ max-width 2))
  4024.      (width (window-width))
  4025.      (cols (/ width col-width))
  4026.      (rows (/ (+ len (1- cols)) cols))
  4027.      (counters nil)
  4028.      (indent))
  4029.     (if (< len cols)
  4030.     (setq col-width (/ width len)
  4031.           max-width (- col-width 2)
  4032.           cols len
  4033.           rows 1))
  4034.     (evi-iterate cols
  4035.       (setq counters (cons (nthcdr (* (1- count) rows) list) counters)))
  4036.     (evi-iterate rows
  4037.       (setq indent 0)
  4038.       (evi-iterate-list item counters
  4039.     (let ((s (car (nthcdr (- rows count) item))))
  4040.       (if s
  4041.           (progn
  4042.         (indent-to indent)
  4043.         (insert (if (> (length s) max-width)
  4044.                 (concat (substring s 0 (- max-width 2)) "...")
  4045.               s))
  4046.         (setq indent (+ indent col-width))))))
  4047.       (insert ?\n))))
  4048.  
  4049. (defun evi-max-len (list)
  4050.   (let ((lengths (mapcar 'length list)))
  4051.     (apply 'max lengths)))
  4052.  
  4053. (defun evi-pretty-char (c)
  4054.   (cond ((evi-is-printable c)
  4055.       (char-to-string c))
  4056.     ((evi-is-control-char c)
  4057.       (if ex-input-escapes
  4058.           (cond ((= c ?\n) "\\n")
  4059.             ((= c ?\r) "\\r")
  4060.             ((= c ?\t) "\\t")
  4061.             ((= c ?\e) "\\e")
  4062.             (t (concat "\\C-"
  4063.                    (char-to-string (+ c (if (< c ?\e) ?` ?@))))))
  4064.         (concat "^" (char-to-string (+ c ?@)))))
  4065.     ((= c ?\C-?)
  4066.       (if ex-input-escapes "\\C-?" "^?"))
  4067.     (t
  4068.       (format "\\%03o" c))))
  4069.  
  4070. (defun evi-pretty-string (s)
  4071.   (mapconcat 'evi-pretty-char s ""))
  4072.  
  4073. ; works for maps as well as abbrev lists
  4074. (defun evi-pretty-binding (b)
  4075.   (concat (evi-pretty-string (car b)) " = "
  4076.       (evi-pretty-string (if (consp (cdr b))
  4077.                  (cdr (cdr b))
  4078.                    (cdr b)))))
  4079.  
  4080. ;; Ex
  4081.  
  4082. ; ZZ this should be cleaned up
  4083. (defvar ex-user-buffer nil)
  4084. (defvar ex-printed nil)
  4085.  
  4086. (defun evi-ex-command ()
  4087.   "Execute an ex command."
  4088.   (interactive)
  4089.   (evi-extend-continuation 'ex-read-command-after
  4090.                (current-window-configuration))
  4091.   (setq ex-user-buffer (current-buffer))
  4092.   (setq ex-printed nil)
  4093.   (evi-read-string ":" nil evi-ex-map evi-ex-input-map))
  4094.  
  4095. (defun ex-read-command-after (wconf)
  4096.   (set-window-configuration wconf)
  4097.   (evi-do-ex-command-string evi-minibuf-contents)
  4098.   (if ex-printed
  4099.       (save-excursion
  4100.     (set-buffer "*Print*")
  4101.     (or (eq (point-min) (point-max))
  4102.         (evi-display-and-prompt
  4103.           (lambda ()
  4104.         (goto-char (point-min))
  4105.         (evi)
  4106.         (display-buffer (current-buffer)))))))
  4107.   (evi-fixup-cursor 'vertical))
  4108.  
  4109. (defun ex-do-completion (name start c-name c-list-fun)
  4110.   (if c-name
  4111.       (if (stringp c-name)
  4112.       (if (string= name c-name)
  4113.           (evi-display-completions (funcall c-list-fun c-name))
  4114.         (progn (delete-region start (point))
  4115.            (insert c-name)))
  4116.     (insert " "))
  4117.     (progn (beep) (save-excursion (insert " [no match]"))
  4118.        (sit-for 2)
  4119.        (delete-region (point) (+ (point) 11)))))
  4120.  
  4121. (defun evi-display-completions (list)
  4122.   (evi-display-list "*Completions*" list "Possible completions are:\n"))
  4123.  
  4124. (defun ex-scan-one-command-point ()
  4125.   (ex-scan-addresses)
  4126.   (let* ((start-of-com (point))
  4127.      (command (ex-scan-command-name)))
  4128.     (if (eolp)
  4129.     (cons (cons 'command start-of-com) (point))
  4130.       (cons (or (ex-scan-parameter-list (cdr (car (cdr command))) t)
  4131.         (cons nil (point)))
  4132.         (point)))))
  4133.  
  4134. (defun ex-scan-command-point ()
  4135.   (let ((res (ex-scan-one-command-point)))
  4136.     (skip-chars-forward " \t")
  4137.     (while (= (following-char) ?|)
  4138.       (forward-char)
  4139.       (setq res (ex-scan-one-command-point)))
  4140.     res))
  4141.  
  4142. (defun ex-is-completable (proto)
  4143.   (or (eq proto 'file) (eq proto 'files) (eq proto 'shell-command)
  4144.       (eq proto 'buffer)
  4145.       (eq proto 'settings)
  4146.       (eq proto 'command) (eq proto 'map) (eq proto 'abbrev)
  4147.       (eq proto 'process)))
  4148.  
  4149. (defun ex-complete ()
  4150.   (interactive)
  4151.   (let* ((cmd-point (progn (beginning-of-line)
  4152.                (forward-char) ; position after `:'
  4153.                (ex-scan-command-point)))
  4154.      (type (car (car cmd-point)))
  4155.      (start-of-word
  4156.        (max (cdr (car cmd-point))
  4157.         (save-excursion (skip-chars-backward "^ \t") (point))))
  4158.      (word (buffer-substring start-of-word (point))))
  4159.     (cond ((or (eq type 'file) (eq type 'files) (eq type 'shell-command))
  4160.         ; ZZ perform substitution?
  4161.         (let* ((name (file-name-nondirectory word))
  4162.            (odir (file-name-directory word))
  4163.            (dir (let ((cur-buffer (current-buffer)))
  4164.               (set-buffer ex-user-buffer)
  4165.               (prog1
  4166.                 (if odir
  4167.                 (expand-file-name odir (evi-current-directory))
  4168.                   (evi-current-directory))
  4169.                 (set-buffer cur-buffer)))))
  4170.           (ex-do-completion name (+ start-of-word (length odir))
  4171.         (file-name-completion name dir)
  4172.         (function (lambda (c-name)
  4173.                 (file-name-all-completions c-name dir))))))
  4174.       ((eq type 'buffer)
  4175.         (let ((buf-list
  4176.            (mapcar 'list
  4177.              (evi-filter (function
  4178.                    (lambda (name) (/= (aref name 0) ? )))
  4179.                  (mapcar 'buffer-name (buffer-list))))))
  4180.           (ex-do-completion word start-of-word
  4181.             (try-completion word buf-list)
  4182.         (function (lambda (c-name)
  4183.                 (all-completions c-name buf-list))))))
  4184.       ((eq type 'settings)
  4185.         (if (> (save-excursion (goto-char start-of-word)
  4186.                    (skip-chars-forward "^=\n")
  4187.                    (point))
  4188.            (point))
  4189.         (beep)
  4190.           (if (and (eq (char-after start-of-word) ?n)
  4191.                (eq (char-after (1+ start-of-word)) ?o)
  4192.                (not (eq (char-after (+ start-of-word 2)) ?v)))
  4193.           (setq word (substring word 2)
  4194.             start-of-word (+ start-of-word 2)))
  4195.           (let ((settings-list (mapcar 'car evi-option-list)))
  4196.         (ex-do-completion word start-of-word
  4197.           (try-completion word settings-list)
  4198.           (function (lambda (c-name)
  4199.                   (all-completions c-name settings-list)))))))
  4200.       ((or (eq type 'command) (eq type 'map) (eq type 'abbrev))
  4201.         (let ((cmd-list
  4202.            (if (eq type 'command)
  4203.                (mapcar 'car ex-commands)
  4204.              (if (eq type 'map)
  4205.              (evi-keymap-bindings evi-map-map)
  4206.                evi-abbrev-list))))
  4207.           (ex-do-completion word start-of-word
  4208.         (try-completion word cmd-list)
  4209.         (function (lambda (c-name)
  4210.                 (all-completions c-name cmd-list))))))
  4211.       ((eq type 'process)
  4212.         (let ((proc-list (mapcar
  4213.                    (function (lambda (x) (list (process-name x))))
  4214.                    (process-list))))
  4215.           (ex-do-completion word start-of-word
  4216.             (try-completion word proc-list)
  4217.         (function (lambda (c-name)
  4218.                 (all-completions c-name proc-list))))))
  4219.       (t (insert ?\t)))))
  4220.  
  4221. (defun evi-filter (pred list)
  4222.   (let* ((head (cons nil nil))
  4223.      (end head))
  4224.     (while list
  4225.       (if (funcall pred (car list))
  4226.       (setq end (setcdr end (cons (car list) nil))))
  4227.       (setq list (cdr list)))
  4228.     (cdr head)))
  4229.  
  4230. (defun evi-do-ex-command-file (filename)
  4231.   (if (file-readable-p filename)
  4232.     (let ((ex-user-buffer (current-buffer))
  4233.       (def-dir (evi-current-directory))
  4234.       (evi-interactive nil))
  4235.       (set-buffer ex-work-space)
  4236.       (erase-buffer)
  4237.       (let ((default-directory def-dir))
  4238.       (insert-file-contents filename))
  4239.       (goto-char (point-min))
  4240.       (evi-do-ex-command)
  4241.       (set-buffer ex-user-buffer))))
  4242.  
  4243. (defun evi-do-ex-command-string (command-string)
  4244.   (let ((ex-user-buffer (current-buffer)))
  4245.     (set-buffer ex-work-space)
  4246.     (erase-buffer)
  4247.     (insert command-string "\n")
  4248.     (goto-char (point-min))
  4249.     (evi-do-ex-command)
  4250.     (set-buffer ex-user-buffer)))
  4251.  
  4252. ;; Note - it is expected that the function that calls this one has set
  4253. ;; ex-user-buffer, and switched to buffer ex-work-space
  4254. (defun evi-do-ex-command ()
  4255.   (while (not (eobp))
  4256.     (let ((command (ex-scan-command)))
  4257.       (set-buffer ex-user-buffer)
  4258.       (if evi-global-directory
  4259.       (setq default-directory (evi-current-directory)))
  4260.       (eval command)
  4261.       (set-buffer ex-work-space)
  4262.       (forward-char))))
  4263.  
  4264. (defun ex-scan-command ()
  4265.   (if (= (following-char) ?:)
  4266.       (forward-char))
  4267.   (if (= (following-char) ?\")
  4268.       (end-of-line))
  4269.   (let* ((addresses (ex-scan-addresses))
  4270.      (command-struct (ex-scan-command-name))
  4271.      (number-of-addresses (car (car (cdr command-struct))))
  4272.      (command-name (car (car command-struct)))
  4273.      (command-prototype (cdr (car (cdr command-struct))))
  4274.      (command-function (cdr (cdr command-struct))))
  4275.     (if (null command-struct)
  4276.       (evi-error "Unknown ex command"))
  4277.     (if (> (ex-count-addresses addresses) number-of-addresses)
  4278.       (evi-error "The %s command only needs %d addresses"
  4279.                 command-name number-of-addresses))
  4280.     (let ((parameter-list (ex-scan-parameter-list command-prototype nil)))
  4281.       (skip-chars-forward " \t")
  4282.       (or (looking-at "[|\n]") (eobp)
  4283.       (evi-error "garbage after end of command: `%s'"
  4284.              (buffer-substring (point)
  4285.                        (progn (skip-chars-forward "^|\n")
  4286.                           (skip-chars-backward " \t")
  4287.                           (point)))))
  4288.       (cons command-function
  4289.         (cond ((eq number-of-addresses 1)
  4290.             (cons (list 'quote (car addresses)) parameter-list))
  4291.           ((eq number-of-addresses 2)
  4292.             (cons (list 'quote addresses) parameter-list))
  4293.           (t
  4294.             parameter-list))))))
  4295.  
  4296. (defun ex-scan-parameter-list (prototype-list completing)
  4297.   (if prototype-list
  4298.     (let ((prototype (cdr (car prototype-list)))
  4299.       (skip-white (eq (car (car prototype-list)) t)))
  4300.       (if skip-white
  4301.       (skip-chars-forward " \t")
  4302.     (if (eq (car (car prototype-list)) 'backup)
  4303.         (backward-char)))
  4304.       (let* ((start (point))
  4305.          (param (if (and (listp prototype) (eq (car prototype) 'if))
  4306.             (if (ex-scan-parameter (nth 1 prototype))
  4307.                 ;; if the test is true, but the body returns `nil',
  4308.                 ;; return `t' anyway so we don't lose the info
  4309.                 (progn
  4310.                   (setq prototype (nth 2 prototype)
  4311.                     start (point))
  4312.                   (or (ex-scan-parameter prototype)
  4313.                   t)))
  4314.               (ex-scan-parameter prototype)))
  4315.          (recurs
  4316.            (if (and completing (eolp) (ex-is-completable prototype))
  4317.            (cons prototype start)
  4318.          (ex-scan-parameter-list (cdr prototype-list) completing))))
  4319.     (if completing
  4320.         recurs
  4321.       (cons param recurs))))))
  4322.  
  4323. (defun ex-scan-parameter (prototype)
  4324.   (cond ((null prototype)
  4325.       nil)
  4326.     ((stringp prototype)
  4327.       (ex-scan-string prototype))
  4328.     ((eq prototype 'address)
  4329.       (list 'quote (ex-scan-address)))
  4330.     ((eq prototype 'register)
  4331.       (list 'quote (ex-scan-register)))
  4332.     ((eq prototype 'file)
  4333.       (ex-scan-quoted "%#*?$[" " \t|\n"))
  4334.     ((or (eq prototype 'buffer)
  4335.          (eq prototype 'words))
  4336.       (ex-scan-quoted nil "|\n"))
  4337.     ((or (eq prototype 'rest-of-line)
  4338.          (eq prototype 'process))
  4339.       (ex-scan-quoted nil "\n"))
  4340.     ((or (eq prototype 'word)
  4341.          (eq prototype 'map)
  4342.          (eq prototype 'abbrev))
  4343.       (ex-scan-quoted nil " \t|\n"))
  4344.     ((eq prototype 'regular-expression)
  4345.       (ex-scan-regular-expression))
  4346.     ((eq prototype 'regular-expression2)
  4347.       (ex-scan-regular-expression t))
  4348.     ((eq prototype 'command)
  4349.       (list 'quote (ex-scan-command)))
  4350.     ((eq prototype 'settings)
  4351.       (list 'quote (ex-scan-settings)))
  4352.     ((eq prototype 'files)
  4353.       (ex-scan-files))
  4354.     ((eq prototype 'shell-command)
  4355.       (ex-scan-quoted "%#" "\n"))
  4356.     ((eq prototype 'offset)
  4357.       (ex-scan-edit-offset))
  4358.     ((eq prototype 'mark)
  4359.       (ex-scan-mark))))
  4360.  
  4361. (defun ex-scan-addresses ()
  4362.   (skip-chars-forward " \t")
  4363.   (if (= (following-char) ?%)
  4364.       (progn (forward-char)
  4365.          (cons (cons (cons 'number 1) 0) (cons (cons 'dollar nil) 0)))
  4366.     (if (looking-at "[-+0-9.$^'/?]")
  4367.       (cons
  4368.     (ex-scan-address)
  4369.     (progn (skip-chars-forward " \t")
  4370.            (if (= (following-char) ?,)
  4371.          (progn (forward-char)
  4372.             (skip-chars-forward " \t")
  4373.             (ex-scan-address))
  4374.          (cons (cons nil nil) 0))))
  4375.       (cons (cons (cons nil nil) 0) (cons (cons nil nil) 0)))))
  4376.  
  4377. (defun ex-scan-address ()
  4378.   (cons (ex-scan-linespec) (ex-scan-line-offset)))
  4379.  
  4380. (defun ex-scan-linespec ()
  4381.   (let ((char (following-char)))
  4382.     (cond
  4383.       ((and (>= char ?0) (<= char ?9))
  4384.     (let ((start (point)))
  4385.       (skip-chars-forward "0-9")
  4386.       (cons 'number (string-to-int (buffer-substring start (point))))))
  4387.       ((eq char ?.)
  4388.     (forward-char)
  4389.     (cons 'dot nil))
  4390.       ((eq char ?$)
  4391.     (forward-char)
  4392.     (cons 'dollar nil))
  4393.       ((eq char ?^)
  4394.         (forward-char)
  4395.     (cons 'prev nil))
  4396.       ((eq char ?')
  4397.     (forward-char 2)
  4398.     (cons 'mark (preceding-char)))
  4399.       ((eq char ?/)
  4400.     (cons 're-forward (ex-scan-regular-expression)))
  4401.       ((eq char ??)
  4402.     (cons 're-backward (ex-scan-regular-expression))))))
  4403.  
  4404. ;; if evi-search-magic is nil, also rework the pattern so that . [ and *
  4405. ;; become literal, and \. \[ and \* are `magic' (i.e. behave as . [ and *
  4406. ;; in a regular expression)
  4407.  
  4408. (defun ex-scan-regular-expression (&optional esc-ampersand)
  4409.   (if (looking-at "[|\n]")
  4410.       nil
  4411.     (forward-char)
  4412.     (let* ((start (point))
  4413.        (stop-chars (concat (if esc-ampersand "&")
  4414.                    (if (not evi-search-magic) ".[*")))
  4415.        (skip-chars (concat "^\n\\\\\C-v" stop-chars
  4416.                    (char-to-string (preceding-char))))
  4417.        (stop-pat (concat "[\\\\\C-v" stop-chars "]")))
  4418.       (skip-chars-forward skip-chars)
  4419.       (while (looking-at stop-pat)
  4420.     (if (or (= (following-char) ?\\) (= (following-char) ?\C-v))
  4421.         (progn (forward-char)
  4422.            (and (/= (length stop-chars) 0)
  4423.             (looking-at (concat "[" stop-chars "]"))
  4424.             (delete-region (1- (point)) (point)))
  4425.            (forward-char))
  4426.       (insert "\\")
  4427.       (forward-char))
  4428.     (skip-chars-forward skip-chars))
  4429.       (prog1
  4430.       (buffer-substring start (point))
  4431.     (if (not (eolp))
  4432.         (forward-char))))))
  4433.  
  4434. (defun ex-scan-line-offset ()
  4435.   (if (looking-at "[0-9+-]")
  4436.       (let ((start (point)))
  4437.     (forward-char)
  4438.     (skip-chars-forward "0-9")
  4439.     ; if they only put a +/- without an offset, default to +/-1
  4440.     (if (and (= (- (point) start) 1) (< (preceding-char) ?0))
  4441.         (if (= (preceding-char) ?+) 1 -1)
  4442.       (string-to-int (buffer-substring start (point)))))
  4443.     0))
  4444.  
  4445. (defun ex-scan-edit-offset ()
  4446.   (if (/= (following-char) ?+)
  4447.       nil
  4448.     (forward-char)
  4449.     (if (evi-is-num (following-char))
  4450.     (ex-scan-line-offset)
  4451.       -1)))
  4452.  
  4453. ;; ZZ maybe recognize here that 0 is invalid?
  4454. (defun ex-define-region (addresses whole-lines default-whole-file)
  4455.   (let ((start (car addresses))
  4456.     (end (cdr addresses)))
  4457.     (if (and (null (car (car start))) default-whole-file)
  4458.     (progn (setq evi-mark (point-min))
  4459.            (goto-char (point-max)))
  4460.       (let ((starting-point (point)))
  4461.     (ex-goto-address start)
  4462.     (setq evi-mark (point))
  4463.     (ex-goto-address end starting-point))
  4464.       (if whole-lines
  4465.       (evi-expand-region-to-lines 'ex)))))
  4466.  
  4467. (defun ex-goto-line (line)
  4468.   (if line
  4469.       (let ((starting-point (point)))
  4470.     (goto-char (point-min))
  4471.     (if (or (> (forward-line (1- line)) 0) (and (eobp) (not (bobp))))
  4472.         (progn (goto-char starting-point)
  4473.            (evi-error "Past end of buffer"))))
  4474.     (progn (goto-char (point-max))
  4475.        (if (= (preceding-char) ?\n)
  4476.            (forward-line -1)
  4477.          (beginning-of-line)))))
  4478.  
  4479. (defun ex-goto-address (address &optional starting-point)
  4480.   (let ((token (car (car address)))
  4481.     (value (cdr (car address))))
  4482.     (cond ((eq token 'number)
  4483.         (ex-goto-line value))
  4484.       ((eq token 'dot)
  4485.         (if starting-point (goto-char starting-point)))
  4486.       ((eq token 'dollar)
  4487.         (ex-goto-line nil))
  4488.       ((eq token 'prev)
  4489.         (if starting-point (goto-char starting-point))
  4490.         (forward-line -1))
  4491.       ((eq token 'mark)
  4492.         (evi-goto-mark-internal value))
  4493.       ((eq token 're-forward)
  4494.         (if (= (length value) 0)
  4495.           (if ex-previous-re
  4496.         (setq value ex-previous-re)
  4497.         (evi-error "No previous regular expression"))
  4498.           (setq ex-previous-re value))
  4499.         (if starting-point (goto-char starting-point))
  4500.         (end-of-line)
  4501.         (let ((message (catch 'abort
  4502.                  (evi-do-search t value 1)
  4503.                  nil)))
  4504.           (if message
  4505.         (progn (forward-line -1)
  4506.                (evi-error message)))))
  4507.       ((eq token 're-backward)
  4508.         (if starting-point (goto-char starting-point))
  4509.         (evi-do-search nil value 1))))
  4510.   (forward-line (cdr address)))
  4511.  
  4512. (defun ex-goto-line-after-address (address)
  4513.   (if (null (car (car address)))
  4514.       (forward-line)
  4515.     (if (and (eq (car (car address)) 'number)
  4516.          (= (cdr (car address)) 0))
  4517.     (goto-char (point-min))
  4518.       (progn (ex-goto-address address)
  4519.          (forward-line)))))
  4520.  
  4521. (defun ex-count-addresses (addresses)
  4522.   (if (eq (car (car (car addresses))) nil)
  4523.     0
  4524.     (if (eq (car (car (cdr addresses))) nil)
  4525.       1
  4526.       2)))
  4527.  
  4528. (defun ex-scan-command-name ()
  4529.   (skip-chars-forward " \t")
  4530.   (let ((start (point)))
  4531.     (if (looking-at "[a-zA-Z!<=>&@]")
  4532.       (progn (forward-char)
  4533.          (let ((char (preceding-char)))
  4534.            (if (or (and (>= char ?a) (<= char ?z))
  4535.                (and (>= char ?A) (<= char ?Z)))
  4536.          (skip-chars-forward "a-zA-Z")))))
  4537.     (ex-lookup-command ex-commands (buffer-substring start (point)))))
  4538.  
  4539. (defun ex-lookup-command (command-list command)
  4540.   (evi-find cmd-struct command-list
  4541.     (if (ex-command-eq command (car cmd-struct))
  4542.       cmd-struct)))
  4543.  
  4544. (defun ex-command-eq (command command-cell)
  4545.   (let ((full-command (car command-cell)))
  4546.     (or (string= command full-command)
  4547.     (let ((command-length (length command)))
  4548.       (and (>= command-length (cdr command-cell))
  4549.            (< command-length (length full-command))
  4550.            (string= command
  4551.             (substring (car command-cell) 0 (length command))))))))
  4552.  
  4553. (defun ex-scan-register ()
  4554.   (if (evi-is-alpha (following-char))
  4555.       (let ((char (following-char)))
  4556.     (forward-char)
  4557.     (cons (evi-register-number char)
  4558.           (not (and (>= char ?a) (<= char ?z)))))
  4559.     (cons evi-register-unnamed nil)))
  4560.  
  4561. (defun ex-scan-mark ()
  4562.   (if (evi-is-alpha (following-char))
  4563.       (let ((char (following-char)))
  4564.     (forward-char)
  4565.     (+ (- char (if (and (>= char ?a) (<= char ?z)) ?a ?A)) 36))
  4566.     (evi-error "marker name required for mark command")))
  4567.  
  4568. (defun ex-scan-files ()
  4569.   (let ((file)
  4570.     (flist nil))
  4571.     (while (> (length (setq file (ex-scan-quoted "%#*?$[" " \t|\n"))) 0)
  4572.       (setq flist (cons file flist))
  4573.       (skip-chars-forward " \t"))
  4574.     (cons 'quote (cons (nreverse flist) nil))))
  4575.  
  4576. (defun ex-scan-quoted (stop-chars delim-chars)
  4577.   (let ((start (point))
  4578.     (skip-chars (concat "^\\\\\C-v" stop-chars delim-chars))
  4579.     (stop-pat (concat "[\\\\\C-v" stop-chars "]"))
  4580.     (expand-glob nil))
  4581.     (skip-chars-forward skip-chars)
  4582.     (while (looking-at stop-pat)
  4583.       (let ((char (following-char)))
  4584.     (cond ((= char ?\C-v)
  4585.         (delete-region (point) (1+ (point)))
  4586.         (forward-char))
  4587.           ((= char ?\\)
  4588.             (if ex-input-escapes
  4589.             (progn
  4590.               (delete-region (point) (1+ (point)))
  4591.               (let ((char (following-char)))
  4592.             (cond ((= char ?e)
  4593.                 (delete-region (point) (1+ (point)))
  4594.                 (insert ?\e))
  4595.                   ((= char ?n)
  4596.                 (delete-region (point) (1+ (point)))
  4597.                 (insert ?\n))
  4598.                   ((= char ?r)
  4599.                 (delete-region (point) (1+ (point)))
  4600.                 (insert ?\r))
  4601.                   ((= char ?t)
  4602.                 (delete-region (point) (1+ (point)))
  4603.                 (insert ?\t))
  4604.                   ((and (= char ?C)
  4605.                     (= (char-after (1+ (point))) ?-))
  4606.                 (let ((char (char-after (+ (point) 2))))
  4607.                   (insert (- char (if (< char ?a) ?@ ?`)))
  4608.                   (delete-region (point) (+ (point) 3))))
  4609.                   (t (forward-char 1)))))
  4610.           (forward-char)))
  4611.           ((= char ?%)
  4612.         (let ((file-name (buffer-file-name ex-user-buffer)))
  4613.           (if file-name
  4614.             (progn
  4615.               (delete-region (point) (1+ (point)))
  4616.               (insert file-name))
  4617.             (evi-error
  4618.               "Buffer has no filename to substitute for %%%%"))))
  4619.           ((= char ?#)
  4620.             (if evi-prev-file
  4621.             (progn
  4622.               (delete-region (point) (1+ (point)))
  4623.               (insert evi-prev-file))
  4624.             (evi-error
  4625.               "No alternate filename to substitute for #")))
  4626.           (t
  4627.         (setq expand-glob t)
  4628.         (forward-char))))
  4629.       (skip-chars-forward skip-chars))
  4630.     (if expand-glob
  4631.       (progn (shell-command-on-region start (point)
  4632.            (concat "echo " (buffer-substring start (point))) t)
  4633.          (goto-char start)
  4634.          (skip-chars-forward (concat "^" delim-chars))))
  4635.     (if (/= start (point))
  4636.     (buffer-substring start (point)))))
  4637.  
  4638. (defun ex-scan-string (string)
  4639.   (let ((string-length (length string)))
  4640.     (if (<= string-length
  4641.         (- (save-excursion (skip-chars-forward "^|\n") (point))
  4642.            (point)))
  4643.       (let ((buffer-string
  4644.           (buffer-substring (point) (+ (point) string-length))))
  4645.     (if (string= string buffer-string)
  4646.       (progn (forward-char string-length)
  4647.          t))))))
  4648.  
  4649. (defun ex-not-implemented (&optional arg)
  4650.   (message "Command not implemented"))
  4651.  
  4652. (defun ex-abbrev (abbrev definition)
  4653.   (if abbrev
  4654.       (let ((elem (assoc abbrev evi-abbrev-list)))
  4655.     (if elem
  4656.         (if definition
  4657.         (setcdr elem (cons (length abbrev) definition))
  4658.           (message "%s" (evi-pretty-string (cdr (cdr elem)))))
  4659.       (if definition
  4660.           (setq evi-abbrev-list
  4661.             (cons
  4662.              (cons abbrev
  4663.                (cons (length abbrev) definition)) evi-abbrev-list))
  4664.         (evi-error "No abbrev for `%s'" abbrev))))
  4665.     (evi-display-list-and-prompt
  4666.       "*Abbrevs*" (mapcar 'evi-pretty-binding evi-abbrev-list))))
  4667.  
  4668. (defun ex-expand-abbrev ()
  4669.   (let ((abbrev evi-abbrev-list)
  4670.     (case-fold-search nil))
  4671.     (while abbrev
  4672.       (if (search-backward (car (car abbrev))
  4673.                (- (point) (nth 1 (car abbrev))) t)
  4674.       (if (evi-is-nonalphanum (preceding-char))
  4675.           (progn
  4676.         (delete-region (point) (+ (point) (nth 1 (car abbrev))))
  4677.         (insert (cdr (cdr (car abbrev)))))
  4678.         (goto-char (+ (point) (nth 1 (car abbrev))))))
  4679.       (setq abbrev (cdr abbrev)))))
  4680.  
  4681. (defun evi-self-insert ()
  4682.   (interactive)
  4683.   (evi-kill-undo-boundary)
  4684.   (if (evi-is-nonalphanum last-command-char)
  4685.       (ex-expand-abbrev))
  4686.   (self-insert-command 1))
  4687.  
  4688. (defun ex-change-buffer (exclam buffer-name)
  4689.   (ex-change-buffer-internal exclam buffer-name nil))
  4690.  
  4691. (defun ex-change-buffer-other-window (exclam buffer-name)
  4692.   (ex-change-buffer-internal exclam buffer-name t))
  4693.  
  4694. (defun ex-change-buffer-internal (exclam buffer-name other-window)
  4695.   (or buffer-name
  4696.       (setq buffer-name (buffer-name (other-buffer (current-buffer)))))
  4697.   (let ((found (ex-verify-buffer buffer-name)))
  4698.     (if (or exclam found)
  4699.       (if other-window
  4700.     (switch-to-buffer-other-window buffer-name)
  4701.     (switch-to-buffer buffer-name))
  4702.       (message "Buffer \"%s\" does not exist" buffer-name))
  4703.     (evi)))
  4704.     ; (and exclam (not found)
  4705.  
  4706. (defun ex-verify-buffer (buffer-name)
  4707.   (evi-find buf (buffer-list) (string= (buffer-name buf) buffer-name)))
  4708.  
  4709. (defun evi-expand-file-name (file-name)
  4710.   (let* ((expanded-name (expand-file-name file-name))
  4711.      (len (length expanded-name)))
  4712.     (if (= (aref expanded-name (1- len)) ?/)
  4713.     expanded-name
  4714.       (concat expanded-name "/"))))
  4715.  
  4716. (defun evi-current-directory ()
  4717.   (if evi-global-directory
  4718.       (car evi-directory-stack)
  4719.     default-directory))
  4720.  
  4721. (defun ex-change-directory (directory-name)
  4722.   (let ((expnd-dir-name (evi-expand-file-name (or directory-name "~"))))
  4723.     (if evi-global-directory
  4724.     (setcar evi-directory-stack expnd-dir-name)
  4725.       (setq default-directory expnd-dir-name))))
  4726.  
  4727. (defun ex-push-directory (directory-name)
  4728.   (if directory-name
  4729.       (setq evi-directory-stack
  4730.         (cons (evi-expand-file-name directory-name) evi-directory-stack))
  4731.     (if (null (cdr evi-directory-stack))
  4732.     (evi-error "Only one directory")
  4733.       (setq evi-directory-stack
  4734.         (cons (nth 1 evi-directory-stack)
  4735.           (cons (car evi-directory-stack)
  4736.             (cdr (cdr evi-directory-stack))))))))
  4737.  
  4738. (defun ex-pop-directory ()
  4739.   (if (null (cdr evi-directory-stack))
  4740.     (evi-error "Only one directory left")
  4741.     (setq evi-directory-stack (cdr evi-directory-stack))))
  4742.  
  4743. (defun ex-directory-stack ()
  4744.   (let ((home (getenv "HOME")))
  4745.     (message
  4746.       (mapconcat (function
  4747.            (lambda (f)
  4748.              (let* ((dir (evi-abbreviate-file-name f home "~"))
  4749.                 (end (1- (length dir))))
  4750.                (if (= (aref dir end) ?/)
  4751.              (substring dir 0 end)
  4752.              dir))))
  4753.          evi-directory-stack " "))))
  4754.  
  4755. (defun ex-copy (from-addresses to-address)
  4756.   (ex-define-region from-addresses t nil)
  4757.   (let ((text (buffer-substring evi-mark (point))))
  4758.     (ex-goto-line-after-address to-address)
  4759.     (insert text)))
  4760.  
  4761. (defun ex-delete (addresses register-struct)
  4762.   (let ((evi-register-spec register-struct))
  4763.     (ex-define-region addresses t nil)
  4764.     (evi-copy-region-to-registers t)
  4765.     ; to make undo's come out right
  4766.     (if (< evi-mark (point))
  4767.       (evi-exchange-point-and-mark))
  4768.     (setq ex-lines-changed (- ex-lines-changed (count-lines (point) evi-mark)))
  4769.     (delete-region (point) evi-mark)))
  4770.  
  4771. (defun ex-edit (exclam offset file-name)
  4772.   (ex-edit-internal exclam offset file-name nil))
  4773.  
  4774. (defun ex-edit-other-window (exclam offset file-name)
  4775.   (ex-edit-internal exclam offset file-name t))
  4776.  
  4777. (defun ex-edit-internal (exclam offset file-name other-window)
  4778.   (if (null file-name)
  4779.       (if (and (not exclam) (not other-window) (buffer-modified-p))
  4780.       (message "Buffer modified since last save (use :edit! to override)")
  4781.     (if other-window
  4782.         (split-window-vertically)
  4783.       (if (null buffer-file-name)
  4784.           (message "Buffer has no file associated with it")
  4785.         (revert-buffer nil t)
  4786.         (evi))))
  4787.     (let ((prev-buf (get-buffer (current-buffer))))
  4788.       (if other-window
  4789.       (find-file-other-window file-name)
  4790.     (find-file file-name))
  4791.       (or (eq prev-buf (get-buffer (current-buffer)))
  4792.       (setq evi-prev-file (buffer-file-name prev-buf)))
  4793.       (evi)))
  4794.   (if offset
  4795.       (ex-goto-line (if (= offset -1) nil offset))))
  4796.  
  4797. (defun ex-elisp-execute (lisp-expression)
  4798.   (eval (car (read-from-string lisp-expression))))
  4799.  
  4800. (defun ex-file (file-name)
  4801.   (if file-name
  4802.       (set-visited-file-name file-name)
  4803.     (evi-file-info)))
  4804.  
  4805. (defun ex-global (addresses notmatch pattern command)
  4806.   (let ((case-fold-search evi-ignore-case)
  4807.     (next-line-mark (make-marker))
  4808.     (end-line-mark (make-marker))
  4809.     (start)
  4810.     (none-found t)
  4811.     (end-pos (point))
  4812.     (large-region))
  4813.     (if (= (length pattern) 0)
  4814.     (if ex-previous-re
  4815.         (setq pattern ex-previous-re)
  4816.       (evi-error "No previous regular expression"))
  4817.       (setq ex-previous-re pattern))
  4818.     (ex-define-region addresses t t)
  4819.     (evi-exchange-point-and-mark)
  4820.     (setq ex-lines-changed 0)
  4821.     (setq large-region (> (- evi-mark (point)) 5000))
  4822.     (if large-region
  4823.       (message "running global command... "))
  4824.     (set-marker end-line-mark evi-mark)
  4825.     (while (< (point) end-line-mark)
  4826.       (setq start (point))
  4827.       (forward-line)
  4828.       (set-marker next-line-mark (point))
  4829.       (goto-char start)
  4830.       (or (eq (re-search-forward pattern (1- next-line-mark) t) notmatch)
  4831.       (progn
  4832.         (goto-char start)
  4833.         (setq none-found nil
  4834.           end-pos (point))
  4835.         (eval command)))
  4836.       (goto-char next-line-mark))
  4837.     (if large-region
  4838.       (message "running global command... complete."))
  4839.     (if (> ex-lines-changed 0)
  4840.         (evi-report-actionc ex-lines-changed "more")
  4841.       (evi-report-actionc (- ex-lines-changed) "fewer"))
  4842.     (set-marker next-line-mark nil)
  4843.     (set-marker end-line-mark nil)
  4844.     (goto-char end-pos)
  4845.     (if none-found
  4846.     (evi-error "No occurance of pattern found"))))
  4847.  
  4848. (defun ex-vglobal (addresses pattern command)
  4849.   (ex-global addresses t pattern command))
  4850.  
  4851. (defun ex-recurse (fun)
  4852.   (let ((ex-user-buffer (current-buffer)))
  4853.     (set-buffer ex-work-space)
  4854.     (let ((work-string (buffer-string))
  4855.       (work-point (point)))
  4856.       (set-buffer ex-user-buffer)
  4857.       (eval fun)
  4858.       (setq ex-user-buffer (current-buffer))
  4859.       (set-buffer ex-work-space)
  4860.       (erase-buffer)
  4861.       (insert work-string)
  4862.       (goto-char work-point)
  4863.       (set-buffer ex-user-buffer))))
  4864.  
  4865. (defun ex-initialize ()
  4866.   (ex-recurse '(evi-customize)))
  4867.  
  4868. (defun ex-kill-buffer (exclam buffer-name)
  4869.   (ex-kill-buffer-internal exclam buffer-name nil))
  4870.  
  4871. (defun ex-kill-buffer-delete-windows (exclam buffer-name)
  4872.   (ex-kill-buffer-internal exclam buffer-name t))
  4873.  
  4874. (defun ex-kill-buffer-internal (exclam buffer windows-too)
  4875.   (setq buffer (get-buffer (or buffer (current-buffer))))
  4876.   (and (not exclam) (buffer-file-name buffer) (buffer-modified-p buffer)
  4877.        (evi-error
  4878.      "No write since last change (use :kill! to override)"))
  4879.   (set-buffer buffer)
  4880.   (set-buffer-modified-p nil)
  4881.   (delete-auto-save-file-if-necessary)
  4882.   (if windows-too
  4883.       (condition-case nil
  4884.       (delete-windows-on buffer)
  4885.     ;; ignore error about trying to delete only window on only screen
  4886.     (error nil)))
  4887.   (kill-buffer buffer)
  4888.   (setq ex-user-buffer (current-buffer)))
  4889.  
  4890. (defvar evi-special-keys
  4891.   '(f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12
  4892.     kp-f1 kp-f2 kp-f3 kp-f4
  4893.     left right up down
  4894.     M-left M-right deletechar deleteline insertline redo undo insert execute
  4895.     begin end next M-next prior home find menu select props
  4896.     kp-enter kp-separator kp-add kp-subtract kp-period
  4897.     kp-0 kp-1 kp-2 kp-3 kp-4 kp-5 kp-6 kp-7 kp-8 kp-9))
  4898.  
  4899. (defun ex-find-fkey (suffix)
  4900.   (let* ((sym (intern suffix))
  4901.      (key (vector sym)))
  4902.     (if (eq window-system 'x)
  4903.     (if (member sym evi-special-keys)
  4904.         key
  4905.       nil)
  4906.       (let* ((bindings (evi-keymap-bindings function-key-map))
  4907.          (it (car bindings))
  4908.          (fkey nil))
  4909.     (while bindings
  4910.       (if (equal (cdr it) key)
  4911.           (setq fkey (car it)
  4912.             bindings nil)
  4913.         (setq bindings (cdr bindings)
  4914.           it (car bindings))))
  4915.     fkey))))
  4916.  
  4917. (defun ex-map (exclam key definition)
  4918.   (let ((map (if exclam evi-input-map-map evi-map-map)))
  4919.     (if key
  4920.     (progn
  4921.       (and (> (length key) 1) (= (aref key 0) ?#)
  4922.            (setq key (if (evi-is-num (aref key 1))
  4923.                  (or (ex-find-fkey
  4924.                   (concat "f" (substring key 1)))
  4925.                  (ex-find-fkey
  4926.                   (concat "kp-f" (substring key 1)))
  4927.                  key)
  4928.                (or (ex-find-fkey (substring key 1))
  4929.                    key))))
  4930.       (if (vectorp key)
  4931.           (define-key evi-top-level-map key 'evi-top-level))
  4932.       (if definition
  4933.           (if exclam
  4934.           (evi-define-key '(input-map) key definition)
  4935.         (evi-define-key '(map) key definition))
  4936.         (let ((mapping (lookup-key map key)))
  4937.           (if (stringp mapping)
  4938.           (message "%s" (evi-pretty-string mapping))
  4939.         (evi-error "No map for `%s'" key)))))
  4940.       (evi-display-list-and-prompt
  4941.     "*Mappings*" (mapcar 'evi-pretty-binding (evi-keymap-bindings map))))))
  4942.  
  4943. (defun ex-mark (address marker)
  4944.   (save-excursion
  4945.     (ex-goto-address address (point))
  4946.     (aset evi-registers marker (point-marker))))
  4947.  
  4948. (defun ex-move (from-addresses to-address)
  4949.   (ex-define-region from-addresses t nil)
  4950.   (let ((text (buffer-substring evi-mark (point)))
  4951.     (to-mark (copy-marker (save-excursion
  4952.                 (ex-goto-line-after-address to-address)
  4953.                 (point)))))
  4954.     ; to make undo's come out right
  4955.     (if (< evi-mark (point))
  4956.       (evi-exchange-point-and-mark))
  4957.     (delete-region (point) evi-mark)
  4958.     (goto-char to-mark)
  4959.     (insert text)
  4960.     (set-marker to-mark nil)))
  4961.  
  4962. (defun ex-preserve ()
  4963.   (do-auto-save))
  4964.  
  4965. (defun ex-print (addresses)
  4966.   (save-excursion
  4967.     (ex-define-region addresses t nil)
  4968.     (insert (prog1
  4969.         (buffer-substring evi-mark (point))
  4970.           (set-buffer (get-buffer-create "*Print*"))
  4971.           (or ex-printed
  4972.           (erase-buffer))
  4973.           (setq ex-printed t)))))
  4974.  
  4975. (defun ex-next (exclam files)
  4976.   (ex-next-internal exclam files nil))
  4977.  
  4978. (defun ex-next-other-window (exclam files)
  4979.   (ex-next-internal exclam files t))
  4980.  
  4981. (defun ex-next-internal (exclam files other-window)
  4982.   (if files
  4983.       (let ((next-buffers
  4984.           (mapcar 'find-file-noselect files)))
  4985.     (if next-buffers
  4986.         (let ((prev-buf (get-buffer (current-buffer))))
  4987.           (if other-window
  4988.           (switch-to-buffer-other-window (car next-buffers))
  4989.         (switch-to-buffer (car next-buffers)))
  4990.           (or (eq prev-buf (get-buffer (current-buffer)))
  4991.           (setq evi-prev-file (buffer-file-name prev-buf)))
  4992.           (evi))))
  4993.     (let ((next-buffer (evi-next-file-buffer t)))
  4994.       (if next-buffer
  4995.       (progn (setq evi-prev-file buffer-file-name)
  4996.          (bury-buffer (current-buffer))
  4997.          (if other-window
  4998.              (switch-to-buffer-other-window next-buffer)
  4999.            (switch-to-buffer next-buffer))
  5000.          (evi))
  5001.     (message "All files are displayed")))))
  5002.  
  5003. (defun evi-next-file-buffer (not-in-window)
  5004.   (let ((rest-of-list
  5005.       (evi-enumerate-condition buffer (cdr (buffer-list))
  5006.         (or (and not-in-window (get-buffer-window buffer))
  5007.         (null (buffer-file-name buffer))))))
  5008.     (if rest-of-list
  5009.       (car rest-of-list))))
  5010.  
  5011. (defun ex-put (address register-struct)
  5012.   (ex-goto-line-after-address address)
  5013.   (let ((register (aref evi-registers (car register-struct))))
  5014.     (if register
  5015.       (save-excursion
  5016.     (if (eq (evi-register-shape register) 'rectangle)
  5017.         (progn (newline (length (evi-register-text register)))
  5018.            (backward-char (length (evi-register-text register)))))
  5019.     (if (eq (evi-register-shape register) 'rectangle)
  5020.         (insert-rectangle (evi-register-text register))
  5021.       (insert (evi-register-text register)))
  5022.     (if (eq (evi-register-shape register) 'chars)
  5023.         (insert ?\n)))
  5024.       (if evi-register-spec
  5025.     (message "Nothing in register %c"
  5026.          (evi-register-name (car evi-register-spec)))
  5027.     (message "No text to put")))))
  5028.  
  5029. ;; ZZ should move to a misc section - actually this shouldn't be here: surely
  5030. ;; this is defined somewhere else?
  5031.  
  5032. (defun evi-list-apply (func l)
  5033.   (if l
  5034.     (progn (apply func (car l) nil)
  5035.        (evi-list-apply func (cdr l)))))
  5036.  
  5037. (defun ex-quit (discard)
  5038.   (funcall evi-quit-function discard))
  5039.  
  5040. (cond ((and (eq evi-emacs-version 'emacs19) window-system)
  5041.         (defun ex-quit-internal (discard)
  5042.       (if (= (length (frame-list)) 1)
  5043.           (ex-really-quit discard)
  5044.         (delete-frame))))
  5045.       ((eq evi-emacs-version 'lucid19)
  5046.         (defun ex-quit-internal (discard)
  5047.       (if (= (length (screen-list)) 1)
  5048.           (ex-really-quit discard)
  5049.         (delete-screen))))
  5050.       (t
  5051.         (defun ex-quit-internal (discard)
  5052.       (ex-really-quit discard))))
  5053.  
  5054. (defun ex-really-quit (discard)
  5055.   (if discard
  5056.       (progn
  5057.     (evi-list-apply
  5058.      (function (lambda (buf)
  5059.              (if (buffer-file-name buf)
  5060.              (progn (set-buffer buf)
  5061.                 (delete-auto-save-file-if-necessary)))))
  5062.      (buffer-list)))
  5063.     (let ((modified-buffers
  5064.          (evi-filter
  5065.            (function (lambda (buf)
  5066.                (let ((c (aref (buffer-name buf) 0)))
  5067.                  (and (buffer-modified-p buf)
  5068.                   (/= c ? ) (/= c ?*)))))
  5069.            (buffer-list))))
  5070.       (if modified-buffers
  5071.       (if (or (cdr modified-buffers)
  5072.           (not (eq (car modified-buffers) (current-buffer))))
  5073.           (evi-error "Modified buffers exist (use :quit! to override, :Wq to save buffers and quit)")
  5074.         (evi-error "No write since last change (use :quit! to override)")))))
  5075.   (kill-emacs))
  5076.  
  5077. (defun ex-read (address shell-command arg)
  5078.   (ex-goto-line-after-address address)
  5079.   (if shell-command
  5080.       (if (eq shell-command t)
  5081.       (evi-error "Incomplete shell escape")
  5082.     (call-process shell-file-name nil t nil "-c" shell-command))
  5083.     (evi-insert-file arg)))
  5084.  
  5085. ; there's a bug in insert-file-contents that doesn't record an undo save
  5086. ; boundary when it's appropriate (ZZ)
  5087. (defun evi-insert-file (filename)
  5088.   (if (boundp 'buffer-undo-list)
  5089.       (progn
  5090.     ;; the insert will record a save record if appropriate
  5091.     (insert ?@)
  5092.     (delete-region (1- (point)) (point))
  5093.     ;; now just erase the existence of the insert and delete
  5094.     (setq buffer-undo-list (cdr (cdr buffer-undo-list)))))
  5095.   (insert-file-contents filename))
  5096.  
  5097. (defun ex-recover (exclam file-name)
  5098.   (or file-name
  5099.       (if (setq file-name buffer-file-name)
  5100.       (and (not exclam) (buffer-modified-p)
  5101.            (evi-error
  5102.         "No write since last change (use :recover! to override)"))
  5103.     (evi-error "Buffer has no file associated with it")))
  5104.   (recover-file file-name)
  5105.   (auto-save-mode 1)
  5106.   (message "Auto save mode on")
  5107.   (evi))
  5108.  
  5109. (defun ex-set (settings)
  5110.   (if settings
  5111.       (ex-set-internal settings)
  5112.     (message (mapconcat 'evi-get-option evi-set-options " "))))
  5113.  
  5114. (defun ex-set-internal (settings)
  5115.   (if settings
  5116.     (let* ((setting (car settings))
  5117.        (name (car setting))
  5118.        (value (cdr setting)))
  5119.       (if (string= name "all")
  5120.       (evi-display-list-and-prompt
  5121.         "*Settings*"
  5122.         (mapcar (function (lambda (x) (evi-get-option (car (car x)))))
  5123.             (evi-filter (function (lambda (x) (cdr (cdr x))))
  5124.                 evi-option-list))
  5125.         nil 'half)
  5126.     (if (integerp value)
  5127.         (progn (princ (evi-get-option name))
  5128.            (princ " "))
  5129.       (evi-set-option name value)))
  5130.       (ex-set-internal (cdr settings)))))
  5131.  
  5132. (defun ex-scan-settings ()
  5133.   (skip-chars-forward " \t")
  5134.   (let ((settings nil))
  5135.     (while (looking-at "[A-Za-z-]")
  5136.       (let ((option (let ((start (point)))
  5137.               (skip-chars-forward "A-Za-z-")
  5138.               (buffer-substring start (point)))))
  5139.     (cond ((looking-at "=")
  5140.         (progn (forward-char 1)
  5141.                (setq settings
  5142.              (cons (cons option (ex-scan-quoted nil " \t|\n"))
  5143.                    settings))))
  5144.           ((looking-at "?")
  5145.         (progn (forward-char 1)
  5146.                (setq settings
  5147.              (cons (cons option ??) settings))))
  5148.           (t
  5149.         (setq settings (cons (cons option t) settings)))))
  5150.       (skip-chars-forward " \t"))
  5151.     (if (looking-at "[^|\n]")
  5152.       (evi-error "Invalid setting%s"
  5153.          (if settings (format " after `%s'" (car (car settings))) "")))
  5154.     settings))
  5155.  
  5156. (defun evi-get-option (option)
  5157.   (let* ((option-struct
  5158.        (or (evi-search-option-list evi-option-list option)
  5159.            (if (and (> (length option) 2)
  5160.             (= (aref option 0) ?n) (= (aref option 1) ?o))
  5161.            (evi-search-option-list evi-option-list
  5162.                        (substring option 2)))))
  5163.      (type (nth 1 option-struct)))
  5164.     (if (eq type nil)
  5165.       (evi-error "Invalid option `%s'" option)
  5166.       (let* ((long-name (car option-struct))
  5167.          (value (condition-case code
  5168.             (eval (cdr (cdr option-struct)))
  5169.               (error nil))))
  5170.     (cond
  5171.       ((eq (cdr (cdr option-struct)) nil)
  5172.         (if (or evi-interactive evi-report-unsupported-options)
  5173.         (evi-error "Option `%s' not implemented" long-name)
  5174.           (concat long-name "=<ignored>")))
  5175.       ((eq type 'bool)
  5176.         (if (eq value t) long-name (concat "no" long-name)))
  5177.       ((eq type 'number)
  5178.         (concat long-name "=" (if value (int-to-string value) "<undef>")))
  5179.       ((eq type 'string)
  5180.         (concat long-name "="
  5181.             (if value (evi-pretty-string value) "<undef>")))
  5182.       ((eq type 'char)
  5183.         (concat long-name "="
  5184.             (if value (evi-pretty-char value) "<undef>")))
  5185.       (t
  5186.         (evi-error "Internal Error: Invalid type `%s'"
  5187.                (prin1-to-string type))))))))
  5188.  
  5189. (defun evi-set-option (option value)
  5190.   (let* ((option-struct
  5191.        (or (evi-search-option-list evi-option-list option)
  5192.            (if (and (> (length option) 2)
  5193.             (= (aref option 0) ?n) (= (aref option 1) ?o))
  5194.            (prog1
  5195.                (evi-search-option-list evi-option-list
  5196.                            (substring option 2))
  5197.              (setq value nil)))))
  5198.      (type (nth 1 option-struct)))
  5199.     (cond
  5200.       ((eq type nil)
  5201.         (evi-warning "Invalid option `%s'" option))
  5202.       ((eq (cdr (cdr option-struct)) nil)
  5203.     (if (or evi-interactive evi-report-unsupported-options)
  5204.         (evi-warning "Option `%s' not implemented" (car option-struct))))
  5205.       ((eq type 'bool)
  5206.         (if (stringp value)
  5207.         (progn
  5208.           (evi-warning "Only %s or no%s allowed" option option)
  5209.           (setq option-struct nil))))
  5210.       ((eq type 'number)
  5211.         (if (stringp value)
  5212.         (setq value (string-to-int value))
  5213.       (evi-warning "Use %s=<number> to set, or %s? to query" option option)
  5214.       (setq option-struct nil)))
  5215.       ((eq type 'string)
  5216.         (or (stringp value)
  5217.         (progn
  5218.           (evi-warning
  5219.         "Use %s=<string> to set, or %s? to query" option option)
  5220.           (set option-struct nil))))
  5221.       ((eq type 'char)
  5222.         (if (stringp value)
  5223.         (if (= (length value) 1)
  5224.         (setq value (aref value 0))
  5225.           (evi-warning 
  5226.         "Only single character can be assigned to `%s'" option)
  5227.           (setq option-struct nil))
  5228.       (evi-warning
  5229.         "Use %s=<character> to set, or %s? to query" option option)
  5230.       (setq option-struct nil)))
  5231.       (t
  5232.     (evi-error "Internal Error: Invalid type `%s'"
  5233.            (prin1-to-string type))))
  5234.     (if (cdr (cdr option-struct))
  5235.     (progn (set (cdr (cdr option-struct)) value)
  5236.            (or (evi-find opt evi-set-options (equal opt option))
  5237.            (if evi-set-options
  5238.                (nconc evi-set-options (list option))
  5239.              (setq evi-set-options (list option))))))
  5240.     (if (fboundp (cdr (cdr option-struct)))
  5241.     (funcall (cdr (cdr option-struct)) value))))
  5242.  
  5243. (defun evi-search-option-list (option-list option)
  5244.   (evi-find option-struct option-list
  5245.         (let ((option-strings (car option-struct)))
  5246.           (if (evi-string-list-match option-strings option)
  5247.           (cons (car option-strings) (cdr option-struct))))))
  5248.  
  5249. (defun evi-string-list-match (string-list string)
  5250.   (if string-list
  5251.     (if (string= string (car string-list))
  5252.     t
  5253.     (evi-string-list-match (cdr string-list) string))))
  5254.  
  5255. (defvar evi-shell-mode-hook nil)
  5256.  
  5257. (defun evi-shell-mode-setup ()
  5258.   (run-hooks 'evi-shell-mode-hook)
  5259.   (set (make-local-variable 'evi-insert-mode-local-bindings) t)
  5260.   (set (make-local-variable 'evi-wrap-margin) 0)
  5261.   (evi-wrap-margin 0)
  5262.   (set (make-local-variable 'evi-emacs-local-suppress-key-list) '(?\e))
  5263.   (evi)
  5264.   (setq evi-buffer-local-vi-map evi-shell-map
  5265.     evi-buffer-local-input-map evi-shell-map))
  5266.  
  5267. (defun evi-shell-send-input ()
  5268.   (interactive)
  5269.   (evi-switch-to-vi)
  5270.   (if (fboundp 'comint-mode)
  5271.       (progn
  5272.     (comint-send-input)
  5273.     (goto-char (process-mark (get-buffer-process (current-buffer))))
  5274.     (evi-insert))
  5275.     (shell-send-input)))
  5276.  
  5277. (defun ex-shell ()
  5278.   (let ((evi-shell-mode-hook
  5279.      (if (boundp 'shell-mode-hook) shell-mode-hook nil))
  5280.     (shell-mode-hook 'evi-shell-mode-setup))
  5281.     (shell)
  5282.     (evi-insert)))
  5283.  
  5284. (defun ex-gdb (program-name)
  5285.   (let ((evi-shell-mode-hook
  5286.      (if (boundp 'gdb-mode-hook) gdb-mode-hook nil))
  5287.     (gdb-mode-hook 'evi-shell-mode-setup))
  5288.     (gdb program-name)
  5289.     (evi-insert)))
  5290.  
  5291. (defun ex-source-file (file-name)
  5292.   (if (file-exists-p file-name)
  5293.       (if (file-readable-p file-name)
  5294.       (ex-recurse (list 'evi-do-ex-command-file file-name))
  5295.     (evi-warning "Unable to read file `%s'" file-name))
  5296.     (evi-warning "No such file or directory: %s" file-name)))
  5297.  
  5298. (defun ex-split (file-name)
  5299.   (split-window-vertically))
  5300.  
  5301. (defun ex-substitute (addresses pattern replacement global query)
  5302.   (let ((case-fold-search evi-ignore-case)
  5303.     (start (point))
  5304.     (end-line-mark (make-marker))
  5305.     (none-found t)
  5306.     (end-pos (point))
  5307.     (large-region))
  5308.     (ex-define-region addresses t nil)
  5309.     (if pattern
  5310.     (if (= (length pattern) 0)
  5311.         (if ex-previous-re
  5312.         (setq pattern ex-previous-re)
  5313.           (goto-char start)
  5314.           (evi-error "No previous regular expression"))
  5315.       (setq ex-previous-re pattern))
  5316.       (if ex-previous-replacement
  5317.       (setq pattern ex-previous-re
  5318.         replacement ex-previous-replacement)
  5319.     (goto-char start)
  5320.     (evi-error "No previous substitution")))
  5321.     (or replacement
  5322.     (setq replacement ""))
  5323.     (setq ex-previous-replacement replacement)
  5324.     ; there are problems with global subst'ing just the beginning or end of a
  5325.     ; line, but in those cases you can only match one per line anyway, so
  5326.     ; demote to a non-global search
  5327.     (if (or (= (aref pattern 0) ?^)
  5328.         (= (aref pattern 0) ?$))
  5329.     (setq global nil))
  5330.     (evi-exchange-point-and-mark)
  5331.     (setq large-region (> (- evi-mark (point)) 5000))
  5332.     (if large-region
  5333.       (message "running substitute command... "))
  5334.     (set-marker end-line-mark evi-mark)
  5335.     (while (and (< (point) end-line-mark)
  5336.         (re-search-forward pattern end-line-mark t))
  5337.       (goto-char (match-beginning 0))
  5338.       (setq none-found nil
  5339.         end-pos (point))
  5340.       (ex-replace-match query replacement)
  5341.       (or global
  5342.       (forward-line)))
  5343.     (if large-region
  5344.       (message "running substitute command... complete."))
  5345.     (set-marker end-line-mark nil)
  5346.     (goto-char end-pos)
  5347.     (if none-found
  5348.     (evi-error "No occurance of pattern `%s' found" pattern))))
  5349.  
  5350. (defun ex-substitute-again (addresses)
  5351.   (ex-substitute addresses "" "" nil nil))
  5352.  
  5353. (if (and (eq evi-emacs-version 'emacs19) (eq window-system 'x))
  5354.     (defun evi-hilight-region (start end)
  5355.       (let ((ov (make-overlay start (1+ end))))
  5356.     (overlay-put ov 'face 'region)
  5357.     (sit-for 99999)
  5358.     (delete-overlay ov)))
  5359.   (defun evi-hilight-region (start end)
  5360.     (let ((here (point))
  5361.       (flag nil)
  5362.       (going t))
  5363.       (goto-char start)
  5364.       (while going
  5365.     (if (not (sit-for 1))
  5366.         (setq going nil)
  5367.       (goto-char (if flag start end))
  5368.       (setq flag (not flag))))
  5369.       (goto-char here))))
  5370.  
  5371. (defun ex-replace-match (query replacement)
  5372.   (if (or (not query)
  5373.       (let ((beginning (match-beginning 0))
  5374.         (end (match-end 0))
  5375.         (answer nil))
  5376.         (while (not answer)
  5377.           (message "replace? (y or n)")
  5378.           (evi-hilight-region beginning (1- end))
  5379.           (setq answer (evi-read-char))
  5380.           ;; ZZ - a bit hardcoded
  5381.           (if (= answer ?\C-c)
  5382.           (keyboard-quit))
  5383.           (if (and (/= answer ?y) (/= answer ?n)
  5384.                (/= answer ?Y) (/= answer ?N))
  5385.           (progn (beep)
  5386.              (setq answer nil))))
  5387.         (or (= answer ?y) (= answer ?Y))))
  5388.       ; need to worry about `magic' here?
  5389.       (replace-match replacement t nil)
  5390.     (goto-char (match-end 0))))
  5391.  
  5392. ; by kind courtesy of Wendell Hicken, whicken@Parasoft.COM
  5393. (defun evi-report-actionc (count msg)
  5394.   (if (> count evi-report-limit)
  5395.       (cond ((or (string= msg "more") (string= msg "fewer"))
  5396.               (message (concat (number-to-string count) " " msg " line"
  5397.                   (if (> count 1) "s" ""))))
  5398.             (t (message (concat (number-to-string count) " line"
  5399.                 (if (> count 1) "s" "") " " msg))))))
  5400.  
  5401. (defun evi-report-action (start end msg)
  5402.   (evi-report-actionc (count-lines start end) msg))
  5403.  
  5404. (defun ex-tag (tag)
  5405.   (if tag
  5406.       (setq ex-tag tag)
  5407.     (or ex-tag
  5408.     (evi-error "No previous tag specified")))
  5409.   (find-tag ex-tag)
  5410.   (evi))
  5411.  
  5412. (defun ex-unabbrev (abbrev)
  5413.   (let ((alist evi-abbrev-list)
  5414.     (alist2 nil))
  5415.     (while alist
  5416.       (if (string= abbrev (car (car alist)))
  5417.       (progn
  5418.         (if alist2
  5419.         (setcdr alist2 (cdr alist))
  5420.           (setq evi-abbrev-list (cdr alist)))
  5421.         (setq alist nil))
  5422.     (setq alist2 alist alist (cdr alist))))))
  5423.  
  5424. (defun ex-unmap (exclam key)
  5425.   (if exclam
  5426.     (evi-define-key '(input-map) key nil)
  5427.     (evi-define-key '(map) key nil)))
  5428.  
  5429. (defun ex-evi-version ()
  5430.   (message evi-version))
  5431.  
  5432. (defun ex-write (addresses exclam shell-command append file-arg)
  5433.   (if shell-command
  5434.       (if (eq shell-command t)
  5435.       (evi-error "Incomplete shell escape")
  5436.     (let ((region (save-excursion (ex-define-region addresses t t)
  5437.                       (cons evi-mark (point)))))
  5438.       (evi-display-and-prompt
  5439.         (function
  5440.           (lambda (cmd)
  5441.         (shell-command-on-region (car region) (cdr region) cmd)
  5442.         (if (eq evi-emacs-version 'emacs19)
  5443.             (and (get-buffer "*Shell Command Output*")
  5444.              (save-excursion
  5445.                (set-buffer "*Shell Command Output*")
  5446.                (> (count-lines (point-min) (point-max)) 1)))
  5447.           t)))
  5448.        (list shell-command))))
  5449.     (let ((file-name (or file-arg buffer-file-name)))
  5450.       (if (not file-name)
  5451.           (message "No current filename")
  5452.     (if (/= (aref file-name 0) ?/)
  5453.         (setq file-name (concat (evi-current-directory) file-name)))
  5454.     (if (or exclam
  5455.         (and buffer-file-name
  5456.              (if (fboundp 'file-truename)
  5457.              (string= (file-truename buffer-file-name)
  5458.                   (file-truename file-name))
  5459.                (string= buffer-file-name file-name)))
  5460.         (or append (not (file-exists-p file-name))))
  5461.         (if (or exclam file-arg (not evi-buffer-read-only))
  5462.         (save-excursion
  5463.           (ex-define-region addresses t t)
  5464.           (if (and (null file-arg)
  5465.                (= evi-mark (point-min)) (= (point) (point-max)))
  5466.               (progn
  5467.             ;; force a write, even if not modified
  5468.             (set-buffer-modified-p t)
  5469.             (basic-save-buffer))
  5470.             (write-region evi-mark (point) file-name append)))
  5471.           (evi-error "File read-only (use :write! to attempt override)"))
  5472.       (evi-error "File exists, use :write! to override"))))))
  5473.  
  5474. (defun ex-write-all-buffers (quietly)
  5475.   (save-some-buffers quietly))
  5476.  
  5477. (defun ex-write-kill ()
  5478.   (set-buffer-modified-p t)
  5479.   (basic-save-buffer)
  5480.   (ex-kill-buffer nil nil))
  5481.  
  5482. (defun ex-write-quit (discard)
  5483.   (set-buffer-modified-p t)
  5484.   (basic-save-buffer)
  5485.   (ex-quit discard))
  5486.  
  5487. (defun ex-write-all-and-quit (quietly)
  5488.   (save-some-buffers quietly t)
  5489.   (ex-quit t))
  5490.  
  5491. (defun ex-yank (addresses register-struct)
  5492.   (let ((evi-register-spec register-struct))
  5493.     (save-excursion
  5494.       (ex-define-region addresses t nil)
  5495.       (evi-copy-region-to-registers nil))))
  5496.  
  5497. (defun ex-shell-command (addresses background shell-command)
  5498.   (if (string= shell-command "!")
  5499.       (setq shell-command
  5500.     (or evi-last-shell-command
  5501.         (evi-error "No previous shell command to substitute for !")))
  5502.     (setq evi-last-shell-command shell-command))
  5503.   (if background
  5504.       (let ((curdir (evi-current-directory)))
  5505.     (switch-to-buffer-other-window
  5506.       (get-buffer-create "*Shell Command Output*"))
  5507.     (evi)
  5508.     (setq default-directory curdir)
  5509.     (erase-buffer)
  5510.     (start-process shell-command
  5511.                "*Shell Command Output*" "sh" "-c" shell-command)
  5512.     (select-window (previous-window)))
  5513.     (if (null (car (car (car addresses))))
  5514.     (progn
  5515.       (save-excursion
  5516.         (set-buffer (get-buffer-create "*Shell Command Output*"))
  5517.         (evi))
  5518.       (evi-display-and-prompt
  5519.         (function
  5520.           (lambda (cmd)
  5521.         (shell-command cmd)
  5522.         (if (eq evi-emacs-version 'emacs19)
  5523.             (and (get-buffer "*Shell Command Output*")
  5524.              (save-excursion
  5525.                (set-buffer "*Shell Command Output*")
  5526.                (> (count-lines (point-min) (point-max)) 1)))
  5527.           t)))
  5528.        (list shell-command)))
  5529.       (progn (ex-define-region addresses t nil)
  5530.          (shell-command-on-region evi-mark (point) shell-command t)))))
  5531.  
  5532. (defun ex-shift-right (addresses)
  5533.   (ex-define-region addresses t nil)
  5534.   (indent-rigidly evi-mark (point) evi-shift-width)
  5535.   (forward-line -1)
  5536.   (skip-chars-forward " \t"))
  5537.  
  5538. (defun ex-shift-left (addresses)
  5539.   (ex-define-region addresses t nil)
  5540.   (indent-rigidly evi-mark (point) (- evi-shift-width))
  5541.   (forward-line -1)
  5542.   (skip-chars-forward " \t"))
  5543.  
  5544. (defun ex-null (addresses)
  5545.   (ex-define-region addresses t nil)
  5546.   (forward-line -1)
  5547.   (skip-chars-forward " \t"))
  5548.  
  5549. (defvar evi-evi-list "evi-list@brandx.rain.com"
  5550.   "Address of site maintaining mailing list for Evi.")
  5551.  
  5552. (defvar evi-bug-address "jlewis@cse.ogi.edu"
  5553.   "Address of who maintains evi.")
  5554.  
  5555. (defun ex-mail (to)
  5556.   (mail nil to)
  5557.   (evi)
  5558.   (message "Type `:send' to send message.  Type `:kill' to abort.")
  5559.   (evi-insert))
  5560.  
  5561. (defun ex-mail-list (subject)
  5562.   (mail nil evi-evi-list subject)
  5563.   (evi)
  5564.   (goto-char (point-max))
  5565.   (insert "Using " evi-version " (" (emacs-version) ").\n\n")
  5566.   (message "Type `:send' to send message.  Type `:kill' to abort.")
  5567.   (evi-insert))
  5568.  
  5569. (defun ex-elisp-bind (input key definition)
  5570.   (funcall 'evi-define-key (if input '(insert replace ex) '(vi))
  5571.                key (car (read-from-string definition))))
  5572.  
  5573. (defun ex-report-bug (subject)
  5574.   (mail nil evi-bug-address subject)
  5575.   (evi)
  5576.   (goto-char (point-max))
  5577.   (insert "In " evi-version " (" (emacs-version) ")\n\n")
  5578.   (message "Type `:send' to send bug report.  Type `:kill' to abort.")
  5579.   (evi-insert))
  5580.  
  5581. (defun ex-send-mail (exclam)
  5582.   (mail-send)
  5583.   (if exclam
  5584.       (ex-kill-buffer t nil)))
  5585.  
  5586. (provide 'evi)
  5587.